1 : C SIAR SOURCE CHAT 05/01/13 03:15:54 5004 2 : SUBROUTINE SIAR 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C OPERATEUR SIAR 7 : C 8 : C A*EVOLUTION ET/OU V*EVOLUTION ET/OU D*EVOLUTION 9 : C 10 : C = SIAR PSNS*EVOLUTION 11 : C 12 : C (M*EVOLUTION FREQ*LISTREEL (TFINAL*FLOTTANT)) 13 : C OU (TFINAL*FLOTTANT) 14 : C 15 : C (OPTION*MOT (TT*FLOTTANT OU II*ENTIER)) 16 : C======================================================================= 17 : C OPTION: 18 : C 19 : C OPTION='ACCE' OU 'VITE' OU 'DEPL' PERMET DE GENERER UNIQUEMENT 20 : C LE SIGNAL DU TYPE INDIQUE. 21 : C 22 : C OPTION='TINI' + TT PERMET D'INDIQUER UN AUTRE INSTANT INITIAL 23 : C QUE LE DEFAUT. 24 : C 25 : C OPTION='NPOI' + NN PERMET D'INDIQUER EXPLICITEMENT LE NOMBRE DE 26 : C POINTS EN TEMPS DU SIGNAL GENERE. 27 : C 28 : C OPTION='NSIN' + NN PERMET DE SPECIFIER LE NB DE SERIE GENEREES. 29 : C 30 : C OPTION='INIT' + NN PERMET D'INITIALISER LE GENERATEUR ALEATOIRE. 31 : C 32 : C OPTION='NCOU' + NN PERMET DE GENERER PLUSIEURS COURBES 33 : C======================================================================= 34 : C PROGRAMMEUR : P.P. 35 : C======================================================================= 36 : C 37 : CHARACTER *72 TI 38 : CHARACTER*12 MOTX,MOTY 39 : C 40 : PARAMETER (NMOCLE=9) 41 : CHARACTER*4 MOTCLE(NMOCLE) 42 : LOGICAL LACCE,LVITE,LDEPL,LMODU, LHARM 43 : C 44 : -INC CCOPTIO 45 : -INC SMEVOLL 46 : -INC SMLREEL 47 : C 48 : POINTEUR IACCE.MLREEL,IVITE.MLREEL,IDEPL.MLREEL,ITEMP.MLREEL 49 : POINTEUR JACCE.MEVOLL,JVITE.MEVOLL,JDEPL.MEVOLL 50 : POINTEUR KACCE.KEVOLL,KVITE.KEVOLL,KDEPL.KEVOLL 51 : POINTEUR IPREQ.MLREEL,IPOWE.MLREEL 52 : SEGMENT MTRAV 53 : IMPLIED IFREQ(2,NBFREQ) 54 : IMPLIED F(NSINUS),SRAC(NSINUS),PHASE(NSINUS) 55 : ENDSEGMENT 56 : C 57 : C 1) LECTURE DES DONNEES GIBIANE 58 : C 59 : C 1.1) LISTE DES MOTS CLEF 60 : C 61 : DATA MOTCLE/'ACCE','VITE','DEPL','INIT','NCOU', 62 : > 'TINI','NPOI','NSIN','HARM'/ 63 : C 64 : C 1.2) DEFAUTS 65 : C 66 : C 67 : LACCE=.FALSE. 68 : LVITE=.FALSE. 69 : LDEPL=.FALSE. 70 : C 71 : NCOURB=1 72 : INITRD=0 73 : NSINUS=0 74 : NPOINT=0 75 : TFINAL=0.D0 76 : TDEBUT=0.D0 77 : LHARM=.FALSE. 78 : C 79 : C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM" 80 : C 80 : CALL LIROBJ('EVOLUTIO',IPPS,1,IRET) 81 : IF(IRET.EQ.0) GOTO 666 82 : C 83 : C 1.4) LECTURE CONDITIONNELLE DE L'OBJET EVOLUTIO CONTENANT 84 : C LES FONCTIONS DE MODULATIONS 85 : C 85 : CALL LIROBJ('EVOLUTIO',IPMOD,0,IRET) 86 : IF(IRET.EQ.0)THEN 87 : LMODU=.FALSE. 88 : ELSE 89 : LMODU=.TRUE. 90 : ENDIF 91 : C 92 : C 1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES 93 : C CAS OU LMODU=.TRUE. 94 : C 95 : IF(LMODU)THEN 95 : CALL LIROBJ('LISTREEL',IPFRE,1,IRET) 96 : IF(IRET.EQ.0) GOTO 666 97 : C 98 : C 1.6) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL (OPTIONEL) 99 : C CAS OU LMODU=.TRUE. 100 : C 100 : CALL LIRREE(TFINA1,0,IRET) 101 : IF(IRET.NE.0)THEN 102 : TFINAL=TFINA1 103 : ENDIF 104 : C 105 : C 1.7) LECTURE DE L'OBJET FLOTTANT INDIQUANT TFINAL 106 : C CAS OU LMODU=.FALSE. 107 : C 108 : ELSE 108 : CALL LIRREE(TFINAL,1,IRET) 109 : IF(IRET.EQ.0) GOTO 666 110 : ENDIF 111 : C 112 : C 1.8) LECTURE DES MOTS-CLEF 113 : C (OPTIONEL) 114 : C 114 : 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) 115 : C 116 : IF(IVAL.EQ.0)GOTO 9 117 : GOTO(101,102,103,104,105,106,107,108,109),IVAL 118 : C ---> "ACCE" 119 : 101 LACCE=.TRUE. 120 : GOTO 1 121 : C ---> "VITE" 122 : 102 LVITE=.TRUE. 123 : GOTO 1 124 : C ---> "DEPL" 125 : 103 LDEPL=.TRUE. 126 : GOTO 1 127 : C ---> "INIT" + NN 127 : 104 CALL LIRENT(INITRD,1,IRET) 128 : IF(IRET.EQ.0) GOTO 666 129 : INITRD=-ABS(INITRD) 130 : GOTO 1 131 : C ---> "NCOU" + NN 131 : 105 CALL LIRENT(NCOURB,1,IRET) 132 : IF(IRET.EQ.0) GOTO 666 133 : GOTO 1 134 : C ---> "TINI" + XX 134 : 106 CALL LIRREE(TDEBUT,1,IRET) 135 : IF(IRET.EQ.0) GOTO 666 136 : GOTO 1 137 : C ---> "NPOI" + NN 137 : 107 CALL LIRENT(NPOINT,1,IRET) 138 : IF(IRET.EQ.0) GOTO 666 139 : GOTO 1 140 : C ---> "NSIN" + NN 140 : 108 CALL LIRENT(NSINUS,1,IRET) 141 : IF(IRET.EQ.0) GOTO 666 142 : GOTO 1 143 : C ---> "HARM" 144 : 109 LHARM=.TRUE. 145 : GOTO 1 146 : C 147 : 9 CONTINUE 148 : C 149 : C 2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS 150 : C (SI LMODU=.TRUE.) 151 : C 152 : IF (LMODU)THEN 153 : C 154 : C 2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE 155 : C 156 : MEVOL2=IPMOD 157 : SEGACT MEVOL2 158 : NBFREQ=MEVOL2.IEVOLL(/1) 159 : C 160 : MLREE3=IPFRE 161 : SEGACT MLREE3 162 : NBFRE1=MLREE3.PROG(/1) -1 163 : C 164 : IF(NBFREQ.NE.NBFRE1)THEN 165 : SEGDES MEVOL2 166 : SEGDES MLREE3 166 : CALL ERREUR(578) 167 : GOTO 666 168 : ENDIF 169 : C 170 : C 2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION 171 : C 172 : KEVOLL=MEVOL2.IEVOLL(1) 173 : SEGACT KEVOLL 174 : MLREEL=IPROGX 175 : SEGACT MLREEL 176 : TINI=PROG(1) 177 : TFIN=PROG(PROG(/1)) 178 : SEGDES MLREEL 179 : SEGDES KEVOLL 180 : C 181 : IF (NBFREQ.GT.1)THEN 182 : DO 10 IE1=2,NBFREQ 183 : KEVOLL=MEVOL2.IEVOLL(IE1) 184 : SEGACT KEVOLL 185 : MLREEL=IPROGX 186 : SEGACT MLREEL 187 : TINI1=PROG(1) 188 : TFIN1=PROG(PROG(/1)) 189 : SEGDES MLREEL 190 : SEGDES KEVOLL 191 : IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-6)THEN 192 : SEGDES MEVOL2 193 : SEGDES MLREE3 193 : CALL ERREUR(579) 194 : GOTO 666 195 : ENDIF 196 : 10 CONTINUE 197 : ENDIF 198 : C 199 : FRMI1=MLREE3.PROG(1) 200 : FRMA1=MLREE3.PROG(NBFREQ+1) 201 : C 202 : ELSE 203 : NBFREQ=1 204 : TINI=0.D0 205 : TFIN=TFINAL 206 : ENDIF 207 : C 208 : TE=TFIN-TINI 209 : C 210 : C 2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE 211 : C 212 : MEVOL1=IPPS 213 : SEGACT MEVOL1 214 : KEVOL1=MEVOL1.IEVOLL(1) 215 : SEGACT KEVOL1 216 : C 217 : ICOUL=KEVOL1.NUMEVX 218 : C 219 : IPREQ=KEVOL1.IPROGX 220 : IPOWE=KEVOL1.IPROGY 221 : SEGACT IPREQ 222 : FRMI=IPREQ.PROG(1) 223 : NSPT=IPREQ.PROG(/1) 224 : FRMA=IPREQ.PROG(NSPT) 225 : C 226 : IF(LMODU)THEN 227 : C 228 : IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-6)THEN 229 : SEGDES IPREQ 230 : SEGDES KEVOL1 231 : SEGDES MEVOL1 232 : SEGDES MEVOL2 233 : SEGDES MLREE3 233 : CALL ERREUR(580) 234 : GOTO 666 235 : ENDIF 236 : ENDIF 237 : C 238 : C 2.4) INTERVALLE DE TEMPS 239 : C 240 : IF(TDEBUT.LT.(TINI-1.D-6))THEN 240 : CALL ERREUR(586) 241 : GOTO 666 242 : ELSEIF(TDEBUT.LT.TINI.OR.TDEBUT.EQ.0.D0)THEN 243 : TDEBUT=TINI 244 : ENDIF 245 : C 246 : IF(TFINAL.GT.(TFIN+1.D-6))THEN 246 : CALL ERREUR(587) 247 : GOTO 666 248 : ELSEIF(TFINAL.GT.TFIN.OR.TFINAL.EQ.0.D0)THEN 249 : TFINAL=TFIN 250 : ENDIF 251 : C 252 : TEF=TFINAL-TDEBUT 253 : C 254 : C 3) CALCUL DES BORNES ET DES DIFFERENTS DEFAUTS 255 : C 256 : C LACCE, LVITE ET LDEPL 257 : C SPECTRE DE PUISSANCE (NSINUS) 258 : C NOMBRE DE POINT D'EVALUATION EN TEMPS (NPOINT) 259 : C 260 : IF((.NOT.LACCE).AND.(.NOT.LVITE).AND.(.NOT.LDEPL))THEN 261 : LACCE=.TRUE. 262 : LVITE=.TRUE. 263 : LDEPL=.TRUE. 264 : ENDIF 265 : C 266 : C 267 : DT=1/(2*FRMA) 268 : NPOITT=INT((TE-1.D-6)/DT)+1 269 : NPOITB=((INT(100*(TEF-1.D-6)/TE)+1)*NPOITT)/100+1 270 : C 271 : IF(NPOINT.EQ.0)THEN 272 : NPOINT=NPOITB 273 : ELSE 274 : TEST=DBLE(NPOINT-NPOITB)/NPOITB 275 : IF(ABS(TEST).GT..1D0)THEN 276 : REAERR(1)=TEST 276 : CALL ERREUR(-280) 277 : ENDIF 278 : ENDIF 279 : DTEF=TEF/(NPOINT-1) 280 : C 281 : NN=INT(LOG(TE/DT)/LOG(2.D0)+1.D-6) 282 : TEFO=2**NN*DT 283 : NSINSB=INT(FRMA*TEFO-1.D-6)+1 284 : NSINSS=INT(NSINSB*FRMI/FRMA-1.D-6)+1 285 : FRMI1=NSINSS/DBLE(NSINSB)*FRMA 286 : NSINSB=NSINSB-NSINSS+1 287 : IF(NSINUS.EQ.0)THEN 288 : NSINUS=NSINSB 289 : FRMI=FRMI1 290 : DFR=(FRMA-FRMI)/(NSINUS-1) 291 : XDECA=1.D0 292 : ELSE 293 : TEST=DBLE(NSINUS-NSINSB)/NSINSB 294 : IF(ABS(TEST).GT..1D0)THEN 295 : REAERR(1)=TEST 295 : CALL ERREUR(-281) 296 : ENDIF 297 : DFR=(FRMA-FRMI)/NSINUS 298 : XDECA=0.5D0 299 : ENDIF 300 : C 301 : C 4) REMPLISSAGE DES TABLEAUX DE TRAVAIL "STATIQUES" 302 : C 303 : SEGINI MTRAV 304 : C 305 : C 4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE 306 : C CHARGEMENT DES POINTS INTERPOLE POUR F ET S 307 : C 308 : SEGACT IPOWE 309 : DPI=8*ATAN(1.D0) 310 : PI=DPI/2 311 : C 312 : IFREQ(1,1)=1 313 : IF (LMODU)THEN 314 : IEFREQ=2 315 : FRM =MLREE3.PROG(IEFREQ) 316 : ELSE 317 : FRM=FRMA 318 : ENDIF 319 : IEF=2 320 : FR=IPREQ.PROG(IEF) 321 : DO 15 IE1=1,NSINUS 322 : F(IE1)=(IE1-XDECA)*DFR + FRMI 323 : DO 11 IE2=IEF,NSPT 324 : IF(F(IE1).GT.(FR+1.D-6))THEN 325 : FR=IPREQ.PROG(IE2+1) 326 : ELSE 327 : GOTO 12 328 : ENDIF 329 : 11 CONTINUE 330 : 12 IEF=IE2 331 : SS= IPOWE.PROG(IEF)-(FR-F(IE1))/(FR-IPREQ.PROG(IEF-1)) 332 : > *(IPOWE.PROG(IEF)-IPOWE.PROG(IEF-1)) 333 : SRAC(IE1)=SQRT(2*SS*DFR) 334 : DO 13 IE2=IEFREQ,NBFREQ+1 335 : IF(F(IE1).GT.(FRM+1.D-6))THEN 336 : FRM =MLREE3.PROG(IE2+1) 337 : IFREQ(2,IE2-1)=IE1-1 338 : IFREQ(1,IE2 )=IE1 339 : ELSE 340 : GOTO 14 341 : ENDIF 342 : 13 CONTINUE 343 : 14 IEFREQ=IE2 344 : 15 CONTINUE 345 : IFREQ(2,NBFREQ)=NSINUS 346 : SEGDES IPREQ 347 : SEGDES IPOWE 348 : SEGDES KEVOL1 349 : SEGDES MEVOL1 350 : IF(LMODU)SEGDES MLREE3 351 : C 352 : C 4.2) DETECTION DE BANDE VIDE 353 : C 354 : IF(NBFREQ.GT.1)THEN 355 : DO 16 IE1=2,NBFREQ 356 : IF(IFREQ(1,IE1).GT.IFREQ(2,IE1))THEN 357 : IFREQ(1,IE1)=0 358 : INTERR(1)=IE1 359 : ENDIF 360 : 16 CONTINUE 361 : ENDIF 362 : C 363 : C 4.3) ON REMPLIT LE TABLEAU DES TEMPS 364 : C 365 : JG=NPOINT 366 : SEGINI ITEMP 367 : TEF=TDEBUT 368 : DO 20 IE1=1,NPOINT 369 : ITEMP.PROG(IE1)=TEF 370 : TEF=TEF+DTEF 371 : 20 CONTINUE 372 : SEGDES ITEMP 373 : C 374 : C 4.4) INITIALISATION DES EVOLL RESULTATS 375 : C 376 : N=NCOURB 377 : IF(LACCE)THEN 378 : SEGINI JACCE 379 : TI='Signal en acceleration' 380 : JACCE.IEVTEX=TI 381 : ENDIF 382 : IF(LVITE)THEN 383 : SEGINI JVITE 384 : TI='Signal en vitesse' 385 : JVITE.IEVTEX=TI 386 : ENDIF 387 : IF(LDEPL)THEN 388 : SEGINI JDEPL 389 : TI='Signal en deplacement' 390 : JDEPL.IEVTEX=TI 391 : ENDIF 392 : C 393 : C 4.5) INITIALISATION DES PHASES (CAS HARMONIQUE) 394 : C 395 : IF(LHARM)THEN 396 : DO 25 IE1=1,NSINUS 397 : PHASE(IE1)=0.D0 398 : 25 CONTINUE 399 : ENDIF 400 : C 401 : C 5) LOOP SUR LES COURBES 402 : C 403 : MOTX='Temps(s)' 404 : DO 46 IE1=1,NCOURB 405 : C 406 : C 5.1) GENERATION DES PHASE (CAS ALEATOIRE) 407 : C 408 : IF(.NOT.LHARM)THEN 409 : DO 30 IE2=1,NSINUS 410 : PHASE(IE2)=TDRAN1(INITRD) * DPI 411 : 30 CONTINUE 412 : ENDIF 413 : C 414 : C 5.2) ETABLISSEMENT DES KEVOLL RESULTATS ET INITIALISATION DES REEL 415 : C 416 : JG=NPOINT 417 : IF(LACCE)THEN 418 : C 419 : SEGINI KACCE 420 : JACCE.IEVOLL(IE1)=KACCE 421 : C 422 : WRITE(TI,'(A22,1X,A6,1X,I2)')'Signal en acceleration', 423 : > 'numero',IE1 424 : WRITE(MOTY,'(9HAccelera.,1X,I2)')IE1 425 : SEGINI IACCE 426 : C 427 : KACCE.KEVTEX=TI 428 : KACCE.NUMEVX=ICOUL 429 : KACCE.NUMEVY='REEL' 430 : KACCE.TYPX='LISTREEL' 431 : KACCE.IPROGX=ITEMP 432 : KACCE.TYPY='LISTREEL' 433 : KACCE.IPROGY=IACCE 434 : KACCE.NOMEVY=MOTY(1:12) 435 : SEGDES KACCE 436 : C 437 : DO 31 IE2=1,NPOINT 438 : IACCE.PROG(IE2)=0.D0 439 : 31 CONTINUE 440 : ENDIF 441 : C 442 : IF(LVITE)THEN 443 : C 444 : SEGINI KVITE 445 : JVITE.IEVOLL(IE1)=KVITE 446 : C 447 : WRITE(TI,'(A17,1X,A6,1X,I2)')'Signal en vitesse', 448 : > 'numero',IE1 449 : WRITE(MOTY,'(9HVitesse ,1X,I2)')IE1 450 : SEGINI IVITE 451 : C 452 : KVITE.KEVTEX=TI 453 : KVITE.NUMEVX=ICOUL 454 : KVITE.NUMEVY='REEL' 455 : KVITE.TYPX='LISTREEL' 456 : KVITE.IPROGX=ITEMP 457 : KVITE.TYPY='LISTREEL' 458 : KVITE.IPROGY=IVITE 459 : KVITE.NOMEVY=MOTY(1:12) 460 : SEGDES KVITE 461 : C 462 : DO 32 IE2=1,NPOINT 463 : IVITE.PROG(IE2)=0.D0 464 : 32 CONTINUE 465 : ENDIF 466 : C 467 : IF(LDEPL)THEN 468 : C 469 : SEGINI KDEPL 470 : JDEPL.IEVOLL(IE1)=KDEPL 471 : C 472 : WRITE(TI,'(A21,1X,A6,1X,I2)')'Signal en deplacement', 473 : > 'numero',IE1 474 : WRITE(MOTY,'(9HDeplacem.,1X,I2)')IE1 475 : SEGINI IDEPL 476 : C 477 : KDEPL.KEVTEX=TI 478 : KDEPL.NUMEVX=ICOUL 479 : KDEPL.NUMEVY='REEL' 480 : KDEPL.TYPX='LISTREEL' 481 : KDEPL.IPROGX=ITEMP 482 : KDEPL.TYPY='LISTREEL' 483 : KDEPL.IPROGY=IDEPL 484 : KDEPL.NOMEVY=MOTY(1:12) 485 : SEGDES KDEPL 486 : C 487 : DO 33 IE2=1,NPOINT 488 : IDEPL.PROG(IE2)=0.D0 489 : 33 CONTINUE 490 : ENDIF 491 : C 492 : C 5.3) BOUCLE SUR LES BANDES DE FREQUENCE 493 : C 494 : DO 44 IE2=1,NBFREQ 495 : IF(IFREQ(1,IE2).EQ.0)GOTO 44 496 : IF(LMODU)THEN 497 : KEVOLL=MEVOL2.IEVOLL(IE2) 498 : SEGACT KEVOLL 499 : MLREE1=IPROGX 500 : MLREE2=IPROGY 501 : SEGACT MLREE1 502 : SEGACT MLREE2 503 : INDICE=2 504 : XTIN=MLREE1.PROG(INDICE-1) 505 : XTOU=MLREE1.PROG(INDICE) 506 : XMIN=MLREE2.PROG(INDICE-1) 507 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 508 : XMTK=XMIN 509 : ELSE 510 : XMTK=1.D0 511 : RATE=0.D0 512 : XTIN=TINI 513 : ENDIF 514 : C 515 : C 5.3bis) CONDITION INITIALE U=V=0 A T=TINI 516 : C 517 : IF(LVITE.OR.LDEPL)THEN 518 : XIVITE=0.D0 519 : IF (LDEPL) XIDEPL=0.D0 520 : DO 330 IE3=IFREQ(1,IE2),IFREQ(2,IE2) 521 : CCOS=COS(DPI*F(IE3)*TINI+PHASE(IE3)) 522 : SSIN=SIN(DPI*F(IE3)*TINI+PHASE(IE3)) 523 : XIVITE=XIVITE +XMTK*SRAC(IE3)/(DPI*F(IE3))*SSIN 524 : > +RATE*SRAC(IE3)/(DPI*F(IE3))**2*CCOS 525 : IF(LDEPL)THEN 526 : XIDEPL=XIDEPL -XMTK*SRAC(IE3)/(DPI*F(IE3))**2*CCOS 527 : > +2*RATE*SRAC(IE3)/(DPI*F(IE3))**3*SSIN 528 : ENDIF 529 : 330 CONTINUE 530 : ENDIF 531 : 532 : 533 : C 534 : C 5.4) BOUCLE SUR LE TEMPS ET INTERPOLATION DES M 535 : C 536 : TEF=TDEBUT 537 : DO 42 IE3=1,NPOINT 538 : IF(LMODU)THEN 539 : IF (TEF.GT.(XTOU+1.E-5))THEN 540 : DO 35 IE4=INDICE,MLREE1.PROG(/1) 541 : INDICE=INDICE+1 542 : IF(LDEPL)XTOTI=XTOU-XTIN 543 : XMIN=MLREE2.PROG(INDICE-1) 544 : XTOU=MLREE1.PROG(INDICE) 545 : XTIN=MLREE1.PROG(INDICE-1) 546 : RATEM=RATE 547 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 548 : RATEM=RATE-RATEM 549 : C 550 : C 5.4bis) DETERMINATION DES CONDITIONS DE RECOLAGES POUR L'INTEGRATION 551 : C NUMERIQUE 552 : C 553 : IF(LVITE.OR.LDEPL)THEN 554 : IF(LDEPL)XIDEPL=XIDEPL+XIVITE*XTOTI 555 : DO 331 IE5=IFREQ(1,IE2),IFREQ(2,IE2) 556 : CCOS=COS(DPI*F(IE5)*XTIN+PHASE(IE5)) 557 : SSIN=SIN(DPI*F(IE5)*XTIN+PHASE(IE5)) 558 : XIVITE=XIVITE 559 : > +RATEM*SRAC(IE5)/(DPI*F(IE5))**2*CCOS 560 : IF(LDEPL)THEN 561 : XIDEPL=XIDEPL 562 : > +2*RATEM*SRAC(IE5)/(DPI*F(IE5))**3*SSIN 563 : ENDIF 564 : 331 CONTINUE 565 : ENDIF 566 : C 567 : IF (TEF.LE.(XTOU+1.E-5))GOTO 36 568 : 35 CONTINUE 569 : 36 CONTINUE 570 : ENDIF 571 : XMTK=XMIN + RATE *(TEF-XTIN) 572 : ENDIF 573 : C 574 : C 5.4ter) MODIFICATIONS LIEES AUX CONDITIONS INITIALES ET DE 575 : C RECOLAGE 576 : C 577 : IF(LVITE)IVITE.PROG(IE3)=IVITE.PROG(IE3)-XIVITE 578 : IF(LDEPL)IDEPL.PROG(IE3)=IDEPL.PROG(IE3)-XIDEPL 579 : > -XIVITE*(TEF-XTIN) 580 : C 581 : C 5.5) BOUCLE SUR LES FREQUENCE DANS CHAQUE BANDE 582 : C ET CALCUL DU SIGNAL 583 : C 584 : DO 40 IE4=IFREQ(1,IE2),IFREQ(2,IE2) 585 : CCOS=COS(DPI*F(IE4)*TEF+PHASE(IE4)) 586 : SSIN=SIN(DPI*F(IE4)*TEF+PHASE(IE4)) 587 : IF(LACCE)THEN 588 : IACCE.PROG(IE3)=IACCE.PROG(IE3) 589 : > +XMTK*SRAC(IE4)*CCOS 590 : ENDIF 591 : IF(LVITE)THEN 592 : IVITE.PROG(IE3)=IVITE.PROG(IE3) 593 : > +XMTK*SRAC(IE4)/(DPI*F(IE4))*SSIN 594 : > +RATE*SRAC(IE4)/(DPI*F(IE4))**2*CCOS 595 : ENDIF 596 : IF(LDEPL)THEN 597 : IDEPL.PROG(IE3)=IDEPL.PROG(IE3) 598 : > -XMTK*SRAC(IE4)/(DPI*F(IE4))**2*CCOS 599 : > +2*RATE*SRAC(IE4)/(DPI*F(IE4))**3*SSIN 600 : ENDIF 601 : 40 CONTINUE 602 : C 603 : TEF=TEF+DTEF 604 : 42 CONTINUE 605 : C 606 : IF(LMODU)THEN 607 : SEGDES MLREE1 608 : SEGDES MLREE2 609 : SEGDES KEVOLL 610 : ENDIF 611 : C 612 : 44 CONTINUE 613 : C 614 : C 5.6) DESACTIVATION DES CALCULS 615 : C 616 : IF(LACCE)SEGDES IACCE 617 : IF(LVITE)SEGDES IVITE 618 : IF(LDEPL)SEGDES IDEPL 619 : 46 CONTINUE 620 : C 621 : IF(LACCE)SEGDES JACCE 622 : IF(LVITE)SEGDES JVITE 623 : IF(LDEPL)SEGDES JDEPL 624 : C 625 : IF(LMODU)SEGDES MEVOL2 626 : C 627 : C 6) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE 628 : C 629 : SEGSUP MTRAV 630 : C 630 : IF(LDEPL)CALL ECROBJ('EVOLUTIO',JDEPL) 630 : IF(LVITE)CALL ECROBJ('EVOLUTIO',JVITE) 630 : IF(LACCE)CALL ECROBJ('EVOLUTIO',JACCE) 631 : C 632 : 666 CONTINUE 633 : RETURN 634 : END 635 : 636 : 637 : 638 :
© Cast3M 2003 - All rights reserved.
Disclaimer