Download respowns.procedur

Back to the list

   1 : * RESPOWNS  PROCEDUR  JC220346  12/09/12    21:15:08     7501           
   2 : *********************************************************************
   3 : *                                            DATE     15/05/90
   4 : *   Procedure RESPOWNS
   5 : *
   6 : *   PSNS = RESPOWNS RSNS M FREQ (OPTION);
   7 : *********************************************************************
   8 : *   objet :
   9 : *
  10 : *   Calcul du spectre de puissance PSNS (objet de type EVOLUTION
  11 : *   comportant une unique courbe) d'un signal stationaire "virtuel"
  12 : *   de duree TE associe a un spectres de reponse RSNS (objet de type
  13 : *   EVOLUTION comportant une courbe) correspondant a un amortissement
  14 : *   AMOR, et a N courbes de modulation M (objet de type EVOLUTIO com-
  15 : *   portant N courbes) aux bandes de frequence indiquees dans FREQ
  16 : *   (objet de type LISTREEL). La bande de frequence de la i-eme fonction
  17 : *   M est donnee par le i-eme (frequence inferieure) et le i+1-eme
  18 : *   (frequence superieure) element de OM.
  19 : *
  20 : *   Les fonctions de modulation doivent toute demarer au meme instant TI
  21 : *   et s'achever au meme instant TF. La duree du signal TE est evidemment
  22 : *   donnee par TF-TI. La frequence de coupure de PSNS est donee par la
  23 : *   valeur maximale de FREQ.
  24 : *
  25 : *   Pour stabiliser le processus de convergence, les iteration
  26 : *   s'effectuent en utilant le filtre de Hanning (HANN).
  27 : *********************************************************************
  28 : *   options :
  29 : *
  30 : *   Les options sont contenues dans OPTION (objet de type TABLE).
  31 : *
  32 : *   OPTION.'GPRP'= objet de type MOT representant la grandeur
  33 : *                  physique de reponse : ACCE(leration), VITE(sse)
  34 : *                  ou DEPL(acement relatif). Le defaut est ACCE.
  35 : *
  36 : *   OPTION.'GPAB'= objet de type MOT representant la grandeur
  37 : *                  physique en abscisse de la reponse: PERI(ode)
  38 : *                  ou FREQ(uence). Le defaut est PERI.
  39 : *
  40 : *   OPTION.'AMOR'= objet de type FLOTTANT specifiant l'amortissement
  41 : *                  AMOR. Le defaut est 0.05.
  42 : *
  43 : *   OPTION.'ONDE'= objet de type FLOTTANT indiquant le temps de base
  44 : *                  a utiliser pour un calcul compatible ondelette.
  45 : *                  La presence de ce parametre indique que l'option
  46 : *                  'ONDE' de l'operateur PRNS est choisi.
  47 : *
  48 : *   OPTION.'FFPS'= objet de type LISTREEL donnant le reticule de
  49 : *                  calcul en frequence du spectre de puissance. Le
  50 : *                  defaut usuel est une progression geometrique entre
  51 : *                  1/TE et la frequence de coupure dont la raison
  52 : *                  est (1+2*KSI), ou KSI=MIN AMOR.
  53 : *                  WARNING: dans le cas ondelette FFPS est necessairement
  54 : *                           determine a partir de FREQ
  55 : *
  56 : *   OPTION.'TTRS'= objet de type LISTREEL donnant le reticule de
  57 : *                  calcul en periode du spectre de reponse. Le
  58 : *                  defaut est celui de l'operateur PSRS.
  59 : *                  WARNING: dans le cas ondelette TTRS est necessairement
  60 : *                           egal a FFPS
  61 : *
  62 : *   OPTION.'DIST'= objet de type MOT representant le type de
  63 : *                  distribution choisi pour evaluer le lieu des
  64 : *                  maxima du spectre de reponse: NEG1 ou NEG2 pour la
  65 : *                  distribution de Newmark/Gumble 1 avec substitution
  66 : *                  ou dichotomie. Le defaut est NEG1.
  67 : *
  68 : *   OPTION.'JMAX'= objet de type ENTIER representant le nombre
  69 : *                  maximum d'iteration autorise. Le defaut est 15.
  70 : *
  71 : *   OPTION.'JHAN'= objet de type ENTIER representant le nombre
  72 : *                  d'iteration comportant le filtrage de Hanning.
  73 : *                  le defaut est JMAX.
  74 : *                  WARNING: dans le cas ondelette JHANN est necessairement
  75 : *                           nul
  76 : *
  77 : *   OPTION.'EMAX'= objet de type REEL representant la limite de
  78 : *                  convergence de l'erreur. Le defaut est 1.E-2.
  79 : *
  80 : *   OPTION.'NBPR'= objet de type ENTIER indiquant le nombre de processus
  81 : *                  stationnaires associe au calcul de spectre de reponse.
  82 : *                  Le defaut est celui de l'operateur PRNS.
  83 : *                  WARNING: dans le cas ondelette NBPR est necessairement
  84 : *                           determine a partir de M
  85 : *
  86 : *   OPTION.'NBIN'= objet de type ENTIER indiquant le nombre de points
  87 : *                  d'integration temporelle associe a chaque processus
  88 : *                  stationnaire. Le  defaut est celui de l'operateur PRNS.
  89 : *                  WARNING: dans le cas ondelette NBIN est necessairement
  90 : *                           determine a partir de M
  91 : *
  92 : *   OPTION.'TPLU'= objet de type FLOTTANT indiquant la duree d'integration
  93 : *                  additionelle relative au modulations non stationnaire. Le
  94 : *                  defaut est 20 sec.
  95 : *
  96 : *   OPTION.'LIST'= objet de type LOGIQUE indiquant la possibilite
  97 : *                  d'affichage du processus de convergence. Le
  98 : *                  defaut est FAUX.
  99 : *
 100 : *   OPTION.'ONDE'= objet de type FLOTTANT indiquant la periode
 101 : *                  d'echantillonage associee a la premiere fonction de
 102 : *                  modulation. La presence de ce parametre indique un
 103 : *                  calcul par ondelette: dans ce cas PSNS contient autant de
 104 : *                  point que de bande de frequence et M la modelisation des
 105 : *                  des coefficient en ondelette: la premiere courbe est le
 106 : *                  residu, et les suivantes sont relatives a chaque niveau
 107 : *                  de decomposition (des basses vers les hautes frequences).
 108 : *
 109 : *********************************************************************
 110 : 'DEBPROC' RESPOWNS RSNS*'EVOLUTION' M*'EVOLUTION' FREQ*'LISTREEL'
 111 :                    OPTION/'TABLE';
 112 : *
 113 : ******* INITIALISATION **********************************************
 114 : *
 115 : *
 116 : *------ Reprise de la table d'entre et/ou introduction des defauts
 117 : *
 118 : 'SI' ('NON' ('EXISTE' OPTION));
 119 :   LOPTION=FAUX;
 120 : 'SINON';
 121 :   LOPTION=VRAI;
 122 : 'FINSI';
 123 : *
 124 : LOK=VRAI;
 125 : *
 126 : GPRP='ACCE';GPAB='PERI';
 127 : AMOR=0.05;
 128 : LONDELET=FAUX;TONDE='TEXT' ' ';
 129 : LFFPS=FAUX;LTTRS=FAUX;
 130 : DIST='NEG2';
 131 : JMAX=15;JHAN=JMAX;EMAX=1.E-2;
 132 : TNBIN='TEXT' ' ';TNBPR='TEXT' ' '; TTPLU='TEXT' ' ';
 133 : LLIST=FAUX;
 134 : 'SI' LOPTION;
 135 :   'SI' ('EXISTE' OPTION 'GPRP'); GPRP='TEXT' OPTION.'GPRP'; 'FINSI';
 136 :   'SI' ('EXISTE' OPTION 'GPAB'); GPAB=OPTION.'GPAB'; 'FINSI';
 137 :   'SI' ('EXISTE' OPTION 'AMOR'); AMOR=OPTION.'AMOR'; 'FINSI';
 138 :   'SI' ('EXISTE' OPTION 'ONDE'); TONDE='TEXT' 'ONDE' OPTION.'ONDE';
 139 :                                  LONDELET=VRAI     ; 'FINSI';
 140 :   'SI' ('NON' LONDELET);
 141 :     'SI' ('EXISTE' OPTION 'FFPS');
 142 :        LFFPS=VRAI;
 143 :        FFPS=OPTION.'FFPS';
 144 :        DFFPS='DIMENSION' FFPS;
 145 :     'FINSI';
 146 :     'SI' ('EXISTE' OPTION 'TTRS');
 147 :        LTTRS=VRAI;
 148 :        TTRS=OPTION.'TTRS';
 149 :     'FINSI';
 150 :   'FINSI';
 151 :   'SI' ('EXISTE' OPTION 'DIST'); DIST=OPTION.'DIST'; 'FINSI';
 152 :   'SI' ('EXISTE' OPTION 'JMAX'); JMAX=OPTION.'JMAX';
 153 :                                  JHAN=JMAX;          'FINSI';
 154 :   'SI' ('EXISTE' OPTION 'EMAX'); EMAX=OPTION.'EMAX'; 'FINSI';
 155 :   'SI' ('EXISTE' OPTION 'JHAN'); JHAN=OPTION.'JHAN'; 'FINSI';
 156 :   'SI' ('EXISTE' OPTION 'NBPR'); TNBPR='TEXT' 'NBPR' OPTION.'NBPR';
 157 :                                                      'FINSI';
 158 :   'SI' ('EXISTE' OPTION 'NBIN'); TNBIN='TEXT' 'NBIN' OPTION.'NBIN';
 159 :                                                      'FINSI';
 160 :   'SI' ('EXISTE' OPTION 'TPLU'); TTPLU='TEXT' 'TPLU' OPTION.'TPLU';
 161 :                                                      'FINSI';
 162 :   'SI' ('EXISTE' OPTION 'LIST'); LLIST=OPTION.'LIST'; 'FINSI';
 163 : 'FINSI';
 164 : *
 165 : RSOPTIO='TEXT' TNBIN TNBPR TTPLU TONDE;
 166 : *
 167 : *'MESSAGE' 'Fin de la reprise';
 168 : *
 169 : *------ Constante relative a la phase de Hanning
 170 : NHANN=3;
 171 : *
 172 : *------ Calcul de TE et de la frequence de coupure FRCO
 173 : *
 174 : FRMIN='EXTRAIRE' FREQ 1;
 175 : NBFREQ='DIMENSION' FREQ;
 176 : FRCO='EXTRAIRE' FREQ NBFREQ;
 177 : NBMODU= NBFREQ - 1;
 178 : *
 179 : TEMPS='EXTRAIRE' M 'ABSC' 1; NBTEMPS='DIMENSION' TEMPS;
 180 : TE=('EXTRAIRE' TEMPS NBTEMPS) - ('EXTRAIRE' TEMPS 1);
 181 : *
 182 : *------ Grille PS et RS pour le calcul par ondelette
 183 : *
 184 : 'SI' (LONDELET);
 185 :    LFFPS=VRAI; LTTRS=VRAI; JHAN=0;
 186 :    DFFPS=NBMODU;
 187 :    J=0; FFPS= 'PROG' NBMODU*0;
 188 :    FFINB=FRMIN;
 189 :    'REPETER' LAFFPS NBMODU;
 190 :       J=J+1; FINIB=FFINB;
 191 :       FFINB='EXTRAIRE' FREQ (J+1);
 192 :       'REMPLACER' FFPS J ((FINIB+FFINB) / 2);
 193 :    'FIN' LAFFPS;
 194 : *
 195 :    'REMPLACER' FFPS 1 FRMIN;
 196 :    'MESSAGE' 'DECENTRAGE DE LA PREMIERE BANDE';
 197 : *
 198 :    TTRSA='PROG' NBMODU*1;
 199 :    TTRS= 'ORDONNER' (TTRSA/FFPS) ;
 200 : 'FINSI';
 201 : *
 202 : *------ Verification de la grille du RS (defaut ou donnee)
 203 : *
 204 : 'SI' (LTTRS);
 205 : *------ On teste les bornes dans le cas non ondelette
 206 :           'SI' ('NON' LONDELET);
 207 :    TTMIN='EXTRAIRE' TTRS 1;
 208 :    NBTTRS='DIMENSION' TTRS;TTMAX='EXTRAIRE' TTRS NBTTRS;
 209 :    'SI' ( (1/TTMAX) '>EG' (FRMIN - 1.D-6) );
 210 :        LOK=FAUX;
 211 :        'MESSAGE' 'LA PERIODE MAXI DE RSPS EST TROP PETITE (FREQ)';
 212 :    'FINSI';
 213 :    'SI' ( (1/TTMIN) '<EG' (FRCO + 1.D-6) );
 214 :        LOK=FAUX;
 215 :        'MESSAGE' 'LA PERIODE MINI DE RSPS EST TROP GRANDE (FREQ)';
 216 :    'FINSI';
 217 :           'FINSI';
 218 : 'SINON';
 219 : *  'SI' ( (1/TE) '>EG' (FRMIN - 1.D-6) );
 220 :    'SI' ( (1/TE) '>EG' (FRMIN + 1.D-6) );
 221 :        LOK=FAUX;
 222 :        'MESSAGE' 'LA FREQUENCE MINI LIEE A TE EST TROP GRANDE (FREQ)';
 223 :    'FINSI';
 224 : *  'SI' ( 25.D0 '<EG' (FRCO + 1.D-6) );
 225 :    'SI' ( 25.D0 '<EG' (FRCO - 1.D-6) );
 226 :        LOK=FAUX;
 227 :        'MESSAGE' 'LA FREQUENCE MAXI (25Hz) EST TROP PETITE (FREQ)';
 228 :    'FINSI';
 229 : 'FINSI';
 230 : 'SI' ('NON' LOK);
 231 :    'MESSAGE' '----> PB AVEC IPOL';
 232 : 'FINSI';
 233 : *
 234 : *------ Generation de la grille des frequence du PS
 235 : *------ ou verification de la grille par defaut
 236 : *
 237 : 'SI' LOK;
 238 :   'SI' ('NON' LFFPS);
 239 :      FXXX= FRMIN;
 240 :      FFPS= 'PROG' FXXX ;
 241 :      UNPXI=1. + (2. * AMOR);
 242 :      J=1;
 243 :      'REPETER' LAB1;
 244 :        FXXX=FXXX * UNPXI;
 245 :        'SI' ( FXXX '>EG' FRCO );
 246 :          'QUITTER' LAB1;
 247 :        'FINSI';
 248 :        J=J+1;
 249 :        FFPS='INSERER' FFPS J FXXX;
 250 :      'FIN' LAB1;
 251 :      DFFPS=J+1;
 252 :     FFPS = 'INSERER' FFPS DFFPS FRCO;
 253 : *'MESSAGE' 'Fin de la generation de FFPS';
 254 :   'FINSI';
 255 : *------ On duplique FFPS (pour mieux detruire l'objet interpole)
 256 :   FFRS= 'COPIER' FFPS;
 257 : *------ On teste les bornes dans le cas non ondelette
 258 :           'SI' ('NON' LONDELET);
 259 :   FRMINB='EXTRAIRE' FFRS 1;
 260 :   'SI' ( ('ABS' (FRMINB-FRMIN)) '>EG' 1.E-5);
 261 :       LOK=FAUX;
 262 :       'MESSAGE' 'LA FREQUENCE MINI DE FFPS EST INCOHERENTE (FREQ)';
 263 :   'FINSI';
 264 :   FRCOB='EXTRAIRE' FFRS DFFPS;
 265 :   'SI' ( ('ABS' (FRCOB-FRCO)) '>EG' 1.E-5);
 266 :       LOK=FAUX;
 267 :       'MESSAGE' 'LA FREQUENCE MAX DE FFPS EST INCOHERENTE (FREQ)';
 268 :   'FINSI';
 269 :           'FINSI';
 270 : *------ On detruit FFRS et eventuellement FFPS en cas d'erreur
 271 : 'FINSI';
 272 : *
 273 : *------ Creation de l'objet evolution contenant le RS
 274 : *------          interpole sur la grille FFPS
 275 : *------ Calcul des references d'erreur
 276 : *
 277 : 'SI' LOK;
 278 : *------ Si le RS est donne en periode on interpole sur une grille
 279 : *------ de periode
 280 :   'SI' ( 'EGA' GPAB 'PERI' );
 281 :     FFPEA='PROG' DFFPS*1;
 282 :     FFPE= 'ORDONNER' (FFPEA/FFRS) ;
 283 :     GRITER=FFPE;
 284 :   'SINON';
 285 :     GRITER=FFRS;
 286 :   'FINSI';
 287 : *'MESSAGE' 'Fin de generation/recuperation de GRITER';
 288 : *------ Min/Max de GRITER
 289 :   XMIGR='EXTRAIRE' GRITER 1;
 290 :   XMAGR='EXTRAIRE' GRITER DFFPS;
 291 : *------ Extraction des courbes
 292 :   ABSI= 'EXTRAIRE' RSNS 'ABSC' 1;
 293 :   ORDI= 'EXTRAIRE' RSNS 'ORDO' 1;
 294 : *'MESSAGE' '  fin extraction';
 295 : *------ Interpolation (on blinde pour que GRITER soit tjs dedans
 296 :   RSTER= 'IPOL' GRITER ABSI ORDI;
 297 : *'MESSAGE' '  fin interpolation';
 298 : *------ Si le RS est donne en periode on le restitue en frequence
 299 :   'SI' ( 'EGA' GPAB 'PERI' );
 300 :     RSTERB=PROG;
 301 :     JF=0;JT=DFFPS+1;
 302 :     'REPETER' LAB3 DFFPS;
 303 :       JT=JT-1; RS='EXTRAIRE' RSTER JT;
 304 :       JF=JF+1;RSTERB ='INSERER' RSTERB JF RS;
 305 :     'FIN' LAB3;
 306 :     RSTER=RSTERB;
 307 : *'MESSAGE' '  fin restitution en frequence';
 308 :   'FINSI';
 309 : *------ On calcul la reference d'erreur
 310 :   ERRN='MAXI' RSTER;
 311 : *------ On genere la courbe RS interpole
 312 :   RSINTERF='EVOL' 'MANU' 'Freq' FFRS 'RSinter' RSTER;
 313 : *'MESSAGE' '  fin concatenation dans RSINTERF';
 314 : *
 315 : *------ On initialise le PS
 316 : *
 317 :   J=0;
 318 :   PS=PROG;
 319 :   'REPETER' LAB5 DFFPS;
 320 :     J=J+1;
 321 :     PS='INSERER' PS J (1.);
 322 :   'FIN' LAB5;
 323 :   PSNS='EVOL' 'MANU' 'Freq' FFPS 'Power Spect.' PS;
 324 : *'MESSAGE' 'fin initialisation PS';
 325 : *
 326 :   'SI' LLIST;
 327 :     'MESSAGE' 'procedure RESPOWNS';
 328 :   'FINSI';
 329 : *
 330 : ******* CALCUL ******************************************************
 331 : *
 332 :   LHANN=VRAI;
 333 :   ERRP=0.;
 334 :   JCALC=0;
 335 :   'REPETER' CALCUL;
 336 :     JCALC=JCALC+1;
 337 : *'MESSAGE' 'Boucle de calcul: Iteration ' JCALC;
 338 : *
 339 : *------ On calcul le RS (en frequence) associe au PS
 340 : *
 341 :     'SI' LTTRS;
 342 :          RSNSC= 'PRNS' PSNS M FREQ AMOR TTRS GPRP DIST 'FREQ'
 343 :                        RSOPTIO;
 344 :     'SINON';
 345 :          RSNSC= 'PRNS' PSNS M FREQ AMOR      GPRP DIST 'FREQ'
 346 :                        RSOPTIO;
 347 :     'FINSI';
 348 : *'MESSAGE' '  Fin du calcul du RS';
 349 : *
 350 : *------ On interpole le RS sur la grille du PS
 351 : *
 352 : *------ Extraction des abscisses/ordonnees
 353 :     ABSI= 'EXTRAIRE' RSNSC 'ABSC' 1;
 354 :     ORDI= 'EXTRAIRE' RSNSC 'ORDO' 1;
 355 : *'MESSAGE' '    Fin extraction RS Calcule';
 356 : *------ Interpolation
 357 :     RSCJ= 'IPOL' FFRS ABSI ORDI;
 358 : *'MESSAGE' '    Fin interpolation';
 359 : *------ Extraction du RS de consigne
 360 :     RSJ  = 'EXTRAIRE' RSINTERF 'ORDO' 1;
 361 : *'MESSAGE' '    Fin extraction RS Consigne';
 362 : *------ Calcul du rapport du calcul a la consigne
 363 :     RAP = RSJ / RSCJ;
 364 : *'MESSAGE' '    Fin calcul amplification RAPJ';
 365 : *------ Determination de l'erreur absolue;
 366 :     ERRRA1 = RSJ - RSCJ;
 367 :     ERRRA2 = 'ABS' ERRRA1;
 368 :     ERRA  = 'MAXI' ERRRA2;
 369 : *'MESSAGE' '  Fin calcul amplification RAP';
 370 : *------ calcul des coefficients
 371 :     COEF = RAP ** 2;
 372 : *'MESSAGE' '  Fin calcul amplification reelle COEF';
 373 : *------ calcul d'erreur
 374 :     ERR = ERRA / ERRN;
 375 : *'MESSAGE' '  Fin calcul mesure scalaire d"erreur';
 376 :     'SI' LLIST;
 377 :       'MESSAGE' 'step' JCALC ' ---> mesure d"erreur=' ERR;
 378 :     'FINSI';
 379 : *------ nouveau PS;
 380 :     PSO  = 'EXTRAIRE' PSNS 'ORDO' 1;
 381 :     PS   = COEF * PSO;
 382 :     PSNS='EVOL' 'MANU' 'Freq' FFPS 'Power Spect.' PS;
 383 : *'MESSAGE' '  Fin calcul nouveau PS';
 384 : *------ fin du calcul???
 385 :     XCONV1=ERR;XCONV2=(ABS (ERRP - ERR))/ERR;
 386 :     'SI' (XCONV1 '>' XCONV2);
 387 :       XCONV=XCONV2;
 388 :     'SINON';
 389 :       XCONV=XCONV1;
 390 :     'FINSI';
 391 :     'SI' (XCONV '<' EMAX);
 392 :        'QUITTER' CALCUL;
 393 :     'FINSI';
 394 :     ERRP=ERR;
 395 : *'MESSAGE' '  Fin test d"erreur';
 396 : *------ fin du calcul en erreur ???
 397 :     'SI' (JCALC '>EG' JMAX); 'QUITTER' CALCUL; 'FINSI';
 398 : *------ filtrage
 399 :     'SI' (JCALC '>EG' JHAN); LHANN=FAUX; 'FINSI';
 400 :     'SI' LHANN;
 401 :       PSPB= 'HANN' PSNS NHANN;
 402 :       PSNS=PSPB;
 403 : *'MESSAGE' '  Fin filtrage';
 404 :     'FINSI';
 405 :   'FIN' CALCUL;
 406 : *'MESSAGE' '  Fin boucle de calcul';
 407 : *
 408 : ******* SORTIE ******************************************************
 409 : *
 410 : 'FINSI';
 411 : 'FINPROC' PSNS;
 412 :  

© Cast3M 2003 - All rights reserved.
Disclaimer