1 : C PRNS SOURCE FANDEUR 13/01/29 21:16:18 7684 2 : C PRNS SOURCE ISPRA 90/05/03 3 : SUBROUTINE PRNS 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : C======================================================================= 7 : C = CALCUL DU "RESPONSE SPECTRUM" A PARTIR DU "POWER SPECTRUM" = 8 : C = DANS LE CAS NON STATIONNAIRE = 9 : C = = 10 : C = SYNTAXE : = 11 : C = = 12 : C = RSNS*EVOL = PRNS PSNS*EVOL = 13 : C = M *EVOL FREQ*LISTREEL = 14 : C = (TT*LISTREEL AMOR*FLOTTANT = 15 : C = MCL1*MOT MCL2*MOT MCL3*MOT = 16 : C = COUL*MOT = 17 : C = MCL4*MOT NUM*ENTIER = 18 : C = MCL5*MOT DTBASE*FLOTTANT ) = 19 : C = = 20 : C = = 21 : C = RSNS : OBJET DE TYPE EVOLUTIO CONTENANT LES = 22 : C = "RESPONSE SPECTRA" (1 COURBE) = 23 : C = = 24 : C = PSPE : OBJET DE TYPE EVOLUTIO CONTENANT LE "POWER SPECTRUM"= 25 : C = ( UNE COURBE SEULEMENT ) = 26 : C = = 27 : C = M : OBJET DE TYPE EVOLUTIO CONTENANT N COURBES = 28 : C = D'EVOLUTIONS TEMPORELLE (LES TEMPS FINALS DOIVENT = 29 : C = ETRE IDENTIQUES) = 30 : C = = 31 : C = FREQ : OBJET DE TYPE LISTREEL CONTENANT N+1 FREQUENCES = 32 : C = (FREQ"(I)" ET FREQ"(I+1)" DEFINISSENT LA BANDE DE = 33 : C = VALIDITE DE M"(I)") = 34 : C = = 35 : C = TT : OBJET DE TYPE LISTREEL CONTENANT LES PERIODES = 36 : C = AMOR : OBJET DE TYPE FLOTTANT CONTENANT L'AMORTISSEMENT = 37 : C = MCL1 : GRANDEUR DE REPONSE: 'DEPL(ACEMENT)', 'VITE(SSE)' = 38 : C = OU 'ACCE(LERATION)' (DEFAUT) = 39 : C = MCL2 : CHOIX DE L'ABSISSE DU "RESPONSE SPECTRUM" = 40 : C = 'FREQ(UENCE)' OU 'PERI(ODE)' (DEFAUT) = 41 : C = DANS LES 2 CAS LES VALEURS SONT RANGEES PAR VALEURS = 42 : C = CROISSANTES DES ABSCISSES (UTILATION DE IPOL!) = 43 : C = MCL3 : CHOIX DE LA DISTRIBUTION: 'NEG1' = 44 : C = OU 'NEG2' (DEFAUT) = 45 : C = COUL : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF) = 46 : C = ( DEFAUT = COULEUR DE PSNL) = 47 : C = MCL4 : INTEGRATION NEWMARK: = 48 : C = 'NBPR(OCESSUS)' + NUM = NB PROCESSUS STATIONAIRES = 49 : C = 'NBIN(TEGRATION)'+ NUM = NB PTS D'INTEGRATION EN T = 50 : C = 'PREC(ISION)'+ ERR = ERREUR PROC. ITERATIFS = 51 : C = 'TPLU(S)' + TPL = TEMPS EN PLUS = 52 : C = 'NBDE(FAUT)' = VALEURS PAR DEFAUT = 53 : C = MCL5 : CALCUL PAR ONDELETTE = 54 : C = 'ONDE' AVEC FCT DE MODULATION CLASSIQUE = 55 : C = OU AVEC COEFF EN ONDELETTE = 56 : C = = 57 : C = CREATION : creation 3/5/90 = 58 : C = MODIF ONDEL : 24/9/90 = 59 : C = DPI NON EGAL A 8*TAN(1.) !!!!: 24/1/91 = 60 : C = AJOUT DE 20 S A LA DUREE : 29/1/91 = 61 : C = MESSAGE D'ERREUR : 15/9/91 = 62 : C = PROGRAMMEUR : P.P. = 63 : C======================================================================= 64 : C 65 : CHARACTER *72 TI 66 : CHARACTER*12 MOTX,MOTY 67 : C 68 : PARAMETER (NMOCLE=13) 69 : CHARACTER*4 MOTCLE(NMOCLE) 70 : LOGICAL LPERIO,LUSER 71 : LOGICAL LONDEL 72 : C 73 : -INC CCGEOME 74 : -INC CCOPTIO 75 : -INC SMEVOLL 76 : -INC SMLREEL 77 : POINTEUR MLREK2.MLREEL 78 : C 79 : DIMENSION XLTI(3) 80 : SEGMENT MTRAV 81 : INTEGER IFREQ(2,NBFREQ) 82 : REAL*8 F(NSPTOM),S(NSPTOM), T(NT), RES(NT) 83 : REAL*8 XLSTAT(3,NBFREQ) 84 : REAL*8 XMTK2(NBFREQ,IPROC) 85 : C REAL*8 XLTIME(NTIME,3) 86 : ENDSEGMENT 87 : C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== 88 : SEGMENT,MMTRA 89 : REAL*8 XLTIME(NNT,3) 90 : ENDSEGMENT 91 : C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== 92 : SEGMENT MONDE 93 : REAL*8 XPAS(NBFREQ) 94 : c* POINTEUR IMTK2(NBFREQ).MLREEL 95 : INTEGER IMTK2(NBFREQ) 96 : ENDSEGMENT 97 : C 98 : C 1) LECTURE DES DONNEES GIBIANE 99 : C 100 : C 1.1) LISTE DES MOTS CLEF 101 : C 102 : DATA MOTCLE/'PERI','FREQ','ACCE','VITE','DEPL', 103 : > 'NBDE','NBPR','NBIN','PREC','NEG1','NEG2', 104 : > 'ONDE','TPLU'/ 105 : C 106 : C 1.2) DEFAUTS 107 : C (MCLE: "'PERI'->LPERIO, 'ACCE'->IGRAND, 'NEWG'->IDISTR) 108 : C 109 : LPERIO=.TRUE. 110 : IGRAND=1 111 : IDISTR=2 112 : C 113 : IPROC=0 114 : IINT=0 115 : AMOR=0.05D0 116 : XRREUR=1.D-3 117 : TPL=20.D0 118 : C 119 : LONDEL=.FALSE. 120 : C 121 : C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM" 122 : C 122 : CALL LIROBJ('EVOLUTIO',IPPS,1,IRET) 123 : IF(IRET.EQ.0) GOTO 666 124 : C 125 : C 1.4) LECTURE DE L'OBJET EVOLUTIO CONTENANT LES FONCTIONS DE MODULATIONS 126 : C 126 : CALL LIROBJ('EVOLUTIO',IPMOD,1,IRET) 127 : IF(IRET.EQ.0) GOTO 666 128 : C 129 : C 1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES 130 : C 130 : CALL LIROBJ('LISTREEL',IPFRE,1,IRET) 131 : IF(IRET.EQ.0) GOTO 666 132 : C 133 : C 1.6) LECTURE DE L'OBJET LISTREEL DONNANT LE TABLEAU DES PERIODES 134 : C DEFINI PAR L'UTILISATEUR (OPTIONEL) 135 : C 135 : CALL LIROBJ('LISTREEL',IPREET,0,IRET) 136 : IF(IRET.EQ.0)THEN 137 : LUSER=.FALSE. 138 : ELSE 139 : LUSER=.TRUE. 140 : ENDIF 141 : C 142 : C 1.7) LECTURE DU REEL DONNANT L'AMORTISSEMENT (OPTIONEL) 143 : C 143 : CALL LIRREE(AMOR1,0,IRET) 144 : IF(IRET.NE.0)THEN 145 : AMOR=AMOR1 146 : ENDIF 147 : C 148 : C 1.8) LECTURE DES MOTS MCL1, MCL2, MCL3, MCL4 ...ET DE LA COULEUR 149 : C (OPTIONEL) 150 : C 150 : * 1 CALL LIRMO2(MOTCLE,NMOCLE,IVAL, 151 : * > NCOUL ,NBCOUL,ICOUL,0) 152 : C 152 : 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) 152 : CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0) 153 : if (icoul.eq.0) icoul=idcoul+1 154 : icoul=icoul-1 155 : C 156 : IF(IVAL.EQ.0)GOTO 9 157 : GOTO(2,3,4,4,4,1,5,6,7,8,8,881,882),IVAL 158 : C ---> "MCL2" 159 : 2 LPERIO=.TRUE. 160 : GOTO 1 161 : 3 LPERIO=.FALSE. 162 : GOTO 1 163 : C ---> "MCL1" 1->ACCE, 2->VITE, 3->DEPL 164 : 4 IGRAND=IVAL-2 165 : GOTO 1 166 : C ---> "MCL4" 1->NBDE, 2->NBPR, 3->NBIN 166 : 5 CALL LIRENT(IPROC,1,IRET) 167 : IF(IRET.EQ.0) GOTO 666 168 : GOTO 1 168 : 6 CALL LIRENT(IINT,1,IRET) 169 : IF(IRET.EQ.0) GOTO 666 170 : GOTO 1 170 : 7 CALL LIRREE(XRREUR,1,IRET) 171 : IF(IRET.EQ.0) GOTO 666 172 : GOTO 1 173 : C ---> "MCL3" 1->NEG1, 2->NEG2 174 : 8 IDISTR=IVAL-9 175 : GOTO 1 176 : C ---> "MCL5" ONDELETTE... 177 : 881 LONDEL=.TRUE. 177 : CALL LIRREE(DTBASE,1,IRET) 178 : IF(IRET.EQ.0) GOTO 666 179 : GOTO 1 180 : C ---> "MCL4" 4->TPL 180 : 882 CALL LIRREE(TPL,1,IRET) 181 : IF(IRET.EQ.0) GOTO 666 182 : GOTO 1 183 : C 184 : C 1.9) "LECTURE" DE LA COULEUR 185 : C 186 : 9 IF(ICOUL.NE.0)GOTO 1 187 : C 188 : IF(IERR.NE.0) GOTO 666 189 : C WRITE(IOIMP,*)'FIN LECTURE' 190 : C 191 : C 2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS 192 : C 193 : C 2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE 194 : C 195 : MEVOL2=IPMOD 196 : SEGACT MEVOL2 197 : NBFREQ=MEVOL2.IEVOLL(/1) 198 : 199 : MLREE3=IPFRE 200 : SEGACT MLREE3 201 : NBFRE1=MLREE3.PROG(/1) -1 202 : 203 : IF(NBFREQ.NE.NBFRE1)THEN 203 : CALL ERREUR(578) 204 : GOTO 665 205 : ENDIF 206 : C 207 : C 2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION 208 : C 209 : KEVOLL=MEVOL2.IEVOLL(1) 210 : SEGACT KEVOLL 211 : MLREEL=IPROGX 212 : SEGACT MLREEL 213 : TINI=PROG(1) 214 : TFIN=PROG(PROG(/1)) 215 : SEGDES MLREEL 216 : SEGDES KEVOLL 217 : 218 : IF (NBFREQ.GT.1)THEN 219 : DO 10 IE1=2,NBFREQ 220 : KEVOLL=MEVOL2.IEVOLL(IE1) 221 : SEGACT KEVOLL 222 : MLREEL=IPROGX 223 : SEGACT MLREEL 224 : TINI1=PROG(1) 225 : TFIN1=PROG(PROG(/1)) 226 : SEGDES MLREEL 227 : SEGDES KEVOLL 228 : IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-5)THEN 228 : CALL ERREUR(579) 229 : GOTO 665 230 : ENDIF 231 : 10 CONTINUE 232 : ENDIF 233 : TE=TFIN-TINI 234 : C 235 : C 2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE 236 : C 237 : FRMI=MLREE3.PROG(1) 238 : FRMA=MLREE3.PROG(NBFREQ+1) 239 : 240 : MEVOL1=IPPS 241 : SEGACT MEVOL1 242 : KEVOL1=MEVOL1.IEVOLL(1) 243 : SEGACT KEVOL1 244 : C 245 : IF(ICOUL.EQ.0) ICOUL=KEVOL1.NUMEVX 246 : C 247 : MLREE1=KEVOL1.IPROGX 248 : MLREE2=KEVOL1.IPROGY 249 : SEGACT MLREE1 250 : FRMI1=MLREE1.PROG(1) 251 : NBSPEC=MLREE1.PROG(/1) 252 : FRMA1=MLREE1.PROG(NBSPEC) 253 : IF(.NOT.LONDEL)THEN 254 : IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-5)THEN 254 : CALL ERREUR(580) 255 : GOTO 664 256 : ENDIF 257 : ENDIF 258 : C 259 : C 2.4) VERIFICATION SPECIFIQUE DU CALCUL EN ONDELETTE 260 : C -NB DE BANDE DE FREQUENCE 261 : C -REPARTITION DES BANDES PAR OCTAVE 262 : C -DETERMINATION DU PAS DE TEMPS D'IDENTIFICATION 263 : C 264 : IF(LONDEL)THEN 265 : C 266 : IF(NBSPEC.NE.NBFREQ)THEN 266 : CALL ERREUR(581) 267 : GOTO 664 268 : ENDIF 269 : C 270 : FREQBA=MLREE3.PROG(2) 271 : FREQB=FREQBA 272 : DO 800 IE1=2,NBFREQ 273 : FFREQ=MLREE3.PROG(IE1+1)-MLREE3.PROG(IE1) 274 : IF (ABS(FFREQ-FREQB)/FREQB.GT.1.D-5)THEN 274 : CALL ERREUR(582) 275 : GOTO 664 276 : ENDIF 277 : FREQC=3*FREQB/2 278 : IF(ABS(MLREE1.PROG(IE1)-FREQC)/FREQC.GT.1.D-5)THEN 278 : CALL ERREUR(583) 279 : GOTO 664 280 : ENDIF 281 : FREQB=FREQB*2 282 : 800 CONTINUE 283 : C 284 : SEGINI, MONDE 285 : DDXMXP=0.D0 286 : DO 805 IE1=1,NBFREQ 287 : KEVOLL=MEVOL2.IEVOLL(IE1) 288 : SEGACT KEVOLL 289 : MLREEL=IPROGX 290 : SEGACT MLREEL 291 : DDXMAX=0.D0 292 : DO 801 IE2=2,PROG(/1) 293 : DDMMA=PROG(IE2)-PROG(IE2-1) 294 : IF(DDMMA.GT.DDXMAX)DDXMAX=DDMMA 295 : 801 CONTINUE 296 : ITE=INT(TE/DDXMAX+1.D-5) 297 : TTEST=TE-ITE*DDXMAX 298 : ITE=INT(DDXMXP/DDXMAX+1.D-5) 299 : TTEST=TTEST+DDXMXP-ITE*DDXMAX 300 : IF((ABS(TTEST).GT.2.D-5).OR.(ITE.GT.2))THEN 301 : INTERR(1)=IE1 301 : CALL ERREUR(584) 302 : DDXMAX=0.D0 303 : DO 802 IE2=2,PROG(/1) 304 : DDXMAX=DDXMAX+(PROG(IE2)-PROG(IE2-1)) 305 : ITE=INT(TE/DDXMAX+1.D-5) 306 : TTEST=TE-ITE*DDXMAX 307 : ITE=INT(DDXMXP/DDXMAX+1.D-5) 308 : TTEST=TTEST+DDXMXP-ITE*DDXMAX 309 : IF((ABS(TTEST).LE.2.D-5).AND.(ITE.LE.2))GOTO 803 310 : 802 CONTINUE 310 : CALL ERREUR(485) 311 : GOTO 663 312 : 803 CONTINUE 313 : ENDIF 314 : XPAS(IE1)=DDXMAX 315 : DDXMXP=DDXMAX 316 : SEGDES MLREEL 317 : SEGDES KEVOLL 318 : 805 CONTINUE 319 : C 320 : ENDIF 321 : C WRITE(IOIMP,*)'FIN VERIFICATION DES DONNEES' 322 : C 323 : C 3) CALCUL DES BORNES DE LA ZONE DE TRAVAIL 324 : C 325 : C SPECTRE DE PUISSANCE + BORNE DE FREQUENCE 326 : C NOMBRE D'OSCILLATEUR POUR LA REPONSE 327 : C NOMBRE DE POINT D'EVALUATION EN TEMPS 328 : C 329 : NSPT=MLREE1.PROG(/1) 330 : NSPTOM=NSPT+NBFREQ-1 331 : C 332 : IF(LONDEL)NSPTOM=NSPTOM+1 333 : C 334 : IF (LUSER)THEN 335 : MLREEL=IPREET 336 : SEGACT MLREEL 337 : NT=PROG(/1) 338 : SEGDES MLREEL 339 : ELSE 340 : NT=75 341 : ENDIF 342 : C 343 : IF (IPROC.EQ.0)THEN 344 : IPROC=INT((TE-1.D-5)/2)+1 345 : ENDIF 346 : IF (IINT.EQ.0)THEN 347 : IINT=10 348 : ENDIF 349 : NTIME=IPROC*IINT+1 350 : IF(LONDEL)THEN 351 : NNTIME=INT(TE/XPAS(NBFREQ)+1.D-5)+1 352 : IF(NNTIME.LT.NTIME)THEN 353 : MMULT=INT(LOG(DBLE((NTIME-1)/(NNTIME-1)))/LOG(2.D0)+1.D-5) 354 : MMULT=2**MMULT 355 : NTIME=MMULT*(NNTIME-1)+1 356 : IPROC=1 357 : ELSE 358 : NTIME=NNTIME 359 : ENDIF 360 : ENDIF 361 : DTIME=TE/(NTIME-1) 362 : C 363 : NTIMEP=INT(TPL/DTIME +1.D-5) 364 : NTIME=NTIME+NTIMEP 365 : C WRITE(IOIMP,*)'FIN CALCUL DES BORNES DE LA ZONE DE TRAVAIL' 366 : C 367 : C 4) REMPLISSAGE DES TABLEAUX DE TRAVAIL 368 : C 369 : NNT=NTIME 370 : SEGINI,MTRAV,MMTRA 371 : C 372 : C 4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE (ON PREVOIT D'INTERCALER 373 : C DES POINTS) 374 : C CALCUL DU NOMBRE DE POINT POUR F ET S 375 : C CHARGEMENT DES POINTS POUR F ET S 376 : C 377 : SEGACT MLREE2 378 : C 379 : IF(LONDEL)THEN 380 : C 381 : DO 810 IE1=1,NBFREQ 382 : IFREQ(1,IE1)=2*IE1-1 383 : IFREQ(2,IE1)=2*IE1 384 : F(2*IE1-1) =MLREE3.PROG(IE1) 385 : F(2*IE1 ) =MLREE3.PROG(IE1+1) 386 : S(2*IE1-1) =MLREE2.PROG(IE1) 387 : S(2*IE1 ) =MLREE2.PROG(IE1) 388 : 810 CONTINUE 389 : C 390 : ELSE 391 : C 392 : IFREQ(1,1)=1 393 : IF(NBFREQ.EQ.1)THEN 394 : IFREQ(2,1)=NSPT 395 : NSPTOT=NSPT 396 : DO 101 IE1=1,NSPTOT 397 : F(IE1)=MLREE1.PROG(IE1) 398 : S(IE1)=MLREE2.PROG(IE1) 399 : 101 CONTINUE 400 : ELSE 401 : IESP=2 402 : IPTSUP=0 403 : F(1)=MLREE1.PROG(1) 404 : S(1)=MLREE2.PROG(1) 405 : DO 13 IE1=2,NBFREQ 406 : FRM =MLREE3.PROG(IE1) 407 : DO 11 IE3=1,NSPT 408 : FRPS=MLREE1.PROG(IESP) 409 : IF(FRPS.GT.(FRM-1.D-5)) GOTO 12 410 : F(IESP+IPTSUP)=FRPS 411 : S(IESP+IPTSUP)=MLREE2.PROG(IESP) 412 : IESP=IESP+1 413 : 11 CONTINUE 414 : 12 IF(FRPS.GT.(FRM+1.D-5))THEN 415 : F(IESP+IPTSUP)=FRM 416 : S(IESP+IPTSUP)=MLREE2.PROG(IESP) 417 : > - (FRPS-FRM)/(FRPS-MLREE1.PROG(IESP-1)) 418 : > *(MLREE2.PROG(IESP)-MLREE2.PROG(IESP-1)) 419 : IFREQ(2,IE1-1)=IESP+IPTSUP 420 : IFREQ(1,IE1 )=IESP+IPTSUP 421 : IPTSUP=IPTSUP+1 422 : ELSE 423 : F(IESP+IPTSUP)=FRPS 424 : S(IESP+IPTSUP)=MLREE2.PROG(IESP) 425 : IFREQ(2,IE1-1)=IESP+IPTSUP 426 : IFREQ(1,IE1 )=IESP+IPTSUP 427 : IESP=IESP+1 428 : ENDIF 429 : 13 CONTINUE 430 : NSPTOT=NSPT+IPTSUP 431 : IFREQ(2,NBFREQ)=NSPTOT 432 : DO 14 IE1=IESP,NSPT 433 : F(IE1+IPTSUP)=MLREE1.PROG(IE1) 434 : S(IE1+IPTSUP)=MLREE2.PROG(IE1) 435 : 14 CONTINUE 436 : ENDIF 437 : C 438 : ENDIF 439 : C 440 : SEGDES MLREE1 441 : SEGDES MLREE2 442 : SEGDES MEVOL1 443 : SEGDES MLREE3 444 : C 445 : C 4.1-BIS) INDICE MIN, LARGEUR DE BANDE DANS IFREQ 446 : C 447 : DO 15 IE1=1,NBFREQ 448 : IFREQ(2,IE1)=IFREQ(2,IE1)-IFREQ(1,IE1) + 1 449 : 15 CONTINUE 450 : C 451 : C 4.2) ON REMPLIT LE TABLEAU DES PERIODES 452 : C 453 : IF (LUSER)THEN 454 : MLREEL=IPREET 455 : SEGACT MLREEL 456 : DO 20 I=1,NT 457 : T(I)=PROG(I) 458 : 20 CONTINUE 459 : SEGDES MLREEL 460 : ELSE 461 : TINF=.04D0 462 : UNPXI=EXP((LOG(TE)-LOG(TINF))/(NT-1)) 463 : T(1)=TINF 464 : DO 21 I=2,NT 465 : 21 T(I)=T(I-1)*UNPXI 466 : T(NT)=TE 467 : ENDIF 468 : C 469 : C 4.3) ON REMPLIT XLTIME (INTERPOLATION DES MK A TR) 470 : C 471 : IF(LONDEL)THEN 472 : C 473 : DDT=DTBASE 474 : DO 817 IE1=1,NBFREQ 475 : KEVOLL=MEVOL2.IEVOLL(IE1) 476 : SEGACT, KEVOLL 477 : MLREE1=IPROGX 478 : MLREE2=IPROGY 479 : SEGACT, MLREE1,MLREE2 480 : DDXMAX=XPAS(IE1) 481 : NNNI=INT(DDXMAX/DDT+1.D-5) 482 : JG=INT(TE/DDXMAX+1.D-5) 483 : C** SEGINI, IMTK2(IE1) 484 : SEGINI,MLREK2 485 : IMTK2(IE1) = MLREK2 486 : TR=TINI 487 : INDICE=2 488 : XTIN=MLREE1.PROG(INDICE-1) 489 : XTOU=MLREE1.PROG(INDICE) 490 : XMIN=MLREE2.PROG(INDICE-1) 491 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 492 : DO 816 IE2=1,JG 493 : VMTK2=0.D0 494 : DO 815 IE3=1,NNNI 495 : TR=TR+DDT 496 : IF (TR.GT.(XTOU+1.E-5))THEN 497 : INDICE=INDICE+1 498 : XTOU=MLREE1.PROG(INDICE) 499 : XTIN=MLREE1.PROG(INDICE-1) 500 : XMIN=MLREE2.PROG(INDICE-1) 501 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 502 : ENDIF 503 : VMTK2=VMTK2+(XMIN + RATE *(TR-XTIN))**2 504 : 815 CONTINUE 505 : C** IMTK2(IE1).PROG(IE2)=VMTK2/NNNI 506 : MLREK2.PROG(IE2)=VMTK2/NNNI 507 : 816 CONTINUE 508 : IF(IE1.GT.1)DDT=DDT/2 509 : SEGDES MLREE1 510 : SEGDES MLREE2 511 : SEGDES KEVOLL 512 : 817 CONTINUE 513 : C 514 : ELSE 515 : C 516 : DPROC=TE/IPROC 517 : DO 26 IE1=1,NBFREQ 518 : KEVOLL=MEVOL2.IEVOLL(IE1) 519 : SEGACT KEVOLL 520 : MLREE1=IPROGX 521 : MLREE2=IPROGY 522 : SEGACT MLREE1 523 : SEGACT MLREE2 524 : INDICE=2 525 : XTIN=MLREE1.PROG(INDICE-1) 526 : XTOU=MLREE1.PROG(INDICE) 527 : XMIN=MLREE2.PROG(INDICE-1) 528 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 529 : DO 25 IE2=1,IPROC 530 : TR=TINI+(IE2-0.5D0)*DPROC 531 : IF (TR.GT.(XTOU+1.E-5))THEN 532 : DO 251 IE3=INDICE,MLREE1.PROG(/1) 533 : INDICE=INDICE+1 534 : XTOU=MLREE1.PROG(INDICE) 535 : IF (TR.LE.(XTOU+1.E-5))GOTO 252 536 : 251 CONTINUE 537 : 252 XTIN=MLREE1.PROG(INDICE-1) 538 : XMIN=MLREE2.PROG(INDICE-1) 539 : RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) 540 : ENDIF 541 : XMTK2(IE1,IE2)=(XMIN + RATE *(TR-XTIN))**2 542 : 25 CONTINUE 543 : SEGDES MLREE1 544 : SEGDES MLREE2 545 : SEGDES KEVOLL 546 : 26 CONTINUE 547 : C 548 : ENDIF 549 : C 550 : SEGDES MEVOL2 551 : C 552 : C 5) CALCUL 553 : C 554 : C 5.1) BOUCLE SUR LES PERIODES 555 : C 556 : INEWT=0 557 : C 558 : DPI=8.D0*ATAN(1.D0) 559 : DO 50 IE1=1,NT 560 : FRQ=1/T(IE1) 561 : WN=FRQ*DPI 562 : C WRITE(IOIMP,*)'BOUCLE PERIODE IT ',IE1 563 : C 564 : C 5.2) CALCUL DES MOMENTS STATIQUES 565 : C 566 : DO 30 IE2=1,NBFREQ 566 : CALL MOMENT(FRQ,AMOR,TE, 567 : > IFREQ(2,IE2),F(IFREQ(1,IE2)),S(IFREQ(1,IE2)) ,IGRAND, 568 : > XLSTAT(1,IE2),XLSTAT(2,IE2),XLSTAT(3,IE2) ) 569 : 30 CONTINUE 570 : C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS STATIQUES' 571 : C 572 : C 5.3) CALCUL DES MOMENT AU COURS DU TEMPS 573 : C PAR CONTRIBUTION DES PROCESSUS ELEMENTAIRES 574 : C 575 : C 5.3.1) MISE A ZERO 576 : C 577 : DO 35 IE2=1,3 578 : DO 35 IE3=1,NTIME 579 : XLTIME(IE3,IE2)=0.D0 580 : 35 CONTINUE 581 : C 582 : IF(.NOT.LONDEL)THEN 583 : C 584 : C 5.3.2) BOUCLE SUR LES PROCESSUS 585 : C 586 : ROTMA=1-EXP(-2*WN*AMOR*DPROC) 587 : DO 40 IE2=1,IPROC 588 : TPROCD=TINI + (IE2-1)*DPROC 589 : TPROCF=TPROCD+DPROC 590 : C 591 : C 5.3.3) SOMME M(TK)*S*H 592 : DO 36 IE3=1,3 593 : XLTI(IE3)=0.D0 594 : DO 36 IE4=1,NBFREQ 595 : XLTI(IE3)=XLTI(IE3) + XMTK2(IE4,IE2)*XLSTAT(IE3,IE4) 596 : 36 CONTINUE 597 : C 598 : C 5.3.4) FONCTION DE PONDERATION DE H... 599 : C 600 : INDOC=(IE2-1)*IINT + 1 601 : INDOCM=INDOC+IINT 602 : DO 38 IE3=INDOC,NTIME 603 : TTDT=(IE3-1)*DTIME 604 : INDT=IE3 605 : IF (INDT.LE.INDOCM)THEN 606 : ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD)) 607 : ELSE 608 : ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF)) 609 : > -EXP(-2*WN*AMOR*(TTDT-TPROCD)) 610 : C 611 : IF((ROT/ROTMA).LT.1.D-3)GOTO 40 612 : C 613 : ENDIF 614 : C 5.3.5) ... ET CONTRIBUTION LAMBDA(T) 615 : C 616 : DO 38 IE4=1,3 617 : XLTIME(INDT,IE4)=XLTIME(INDT,IE4)+ 618 : > ROT*XLTI(IE4) 619 : 38 CONTINUE 620 : 40 CONTINUE 621 : C 622 : ELSE 623 : C 624 : C 625 : C 5.3.2.o) BOUCLE SUR LES FREQUENCE 626 : C 627 : DO 823 IE2=1,NBFREQ 628 : C* IPROC=IMTK2(IE2).PROG(/1) 629 : MLREK2 = IMTK2(IE2) 630 : IPROC = MLREK2.PROG(/1) 631 : DPROC=XPAS(IE2) 632 : IINT=INT(DPROC/DTIME+1.D-5) 633 : ROTMA=1-EXP(-2*WN*AMOR*DPROC) 634 : C 635 : C 5.3.2.o) BOUCLE SUR LES PROCESSUS 636 : C 637 : DO 822 IE3=1,IPROC 638 : TPROCD=TINI + (IE3-1)*DPROC 639 : TPROCF=TPROCD+DPROC 640 : C 641 : C 5.3.3.o) PRODUIT M(TK)*S*H 642 : C 643 : SI2I3 = MLREK2.PROG(IE3) 644 : DO 820 IE4=1,3 645 : C** XLTI(IE4)=IMTK2(IE2).PROG(IE3)*XLSTAT(IE4,IE2) 646 : XLTI(IE4) = SI2I3 * XLSTAT(IE4,IE2) 647 : 820 CONTINUE 648 : C 649 : C 5.3.4.o) FONCTION DE PONDERATION DE H... 650 : C 651 : INDOC=(IE3-1)*IINT + 1 652 : INDOCM=INDOC+IINT 653 : DO 821 IE4=INDOC,NTIME 654 : TTDT=(IE4-1)*DTIME 655 : INDT=IE4 656 : IF (INDT.LE.INDOCM)THEN 657 : ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD)) 658 : ELSE 659 : ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF)) 660 : > -EXP(-2*WN*AMOR*(TTDT-TPROCD)) 661 : C 662 : IF((ROT/ROTMA).LT.1.D-3)GOTO 822 663 : C 664 : ENDIF 665 : C 5.3.5.o) ... ET CONTRIBUTION LAMBDA(T) 666 : C 667 : DO 821 IE5=1,3 668 : XLTIME(INDT,IE5)=XLTIME(INDT,IE5)+ 669 : > ROT*XLTI(IE5) 670 : 821 CONTINUE 671 : 822 CONTINUE 672 : 823 CONTINUE 673 : C 674 : ENDIF 675 : C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS EN TEMPS' 676 : C 677 : C 5.4) CALCUL DU RESPONSE SPECTRA 678 : C 678 : CALL DISTRT(MMTRA, NTIME, DTIME, DPI, 679 : > TE, IDISTR,XRREUR, VALMAX ,IOK ,INEW) 680 : RES(IE1)=VALMAX 681 : IF(IOK.NE.0)THEN 682 : IF(IOK.LT.100)THEN 683 : SEGSUP MTRAV,MMTRA 684 : GOTO 666 685 : ENDIF 686 : ENDIF 687 : C 688 : INEWT=INEWT+INEW 689 : 50 CONTINUE 690 : C WRITE(IOIMP,*)'FIN CALCUL DES RESULTATS' 691 : C 692 : IF(IIMPI.EQ.1)WRITE(IOIMP,*)'NB DE CALCUL DE LA DISTRIBUTION=' 693 : > ,INEWT 694 : C 695 : C 6) STOCKAGE DES RESULTAT 696 : C 697 : C 6.1) ABSISSE EN PERIODE OU EN FREQUENCE 698 : C 699 : IF(LPERIO.AND.LUSER)THEN 700 : MLREE1=IPREET 701 : MOTX='PERIODE' 702 : ELSE 703 : JG=NT 704 : SEGINI MLREE1 705 : IF(LPERIO)THEN 706 : DO 60 I=1,NT 707 : MLREE1.PROG(I)=T(I) 708 : 60 CONTINUE 709 : MOTX='PERIODE' 710 : ELSE 711 : DO 61 I=1,NT 712 : MLREE1.PROG(NT-I+1)=1/T(I) 713 : 61 CONTINUE 714 : MOTX='FREQUENCE' 715 : ENDIF 716 : SEGDES MLREE1 717 : ENDIF 718 : C 719 : C 6.2) LEGENDE (PARTIELLE) DES ORDONNEES 720 : C 721 : MOTY(1:10)='RSPE-'//MOTCLE(2+IGRAND)//' ' 722 : C 723 : C 6.3) CREATION DE L'OBJET EVOLUTIO RSNS 724 : C 725 : N=1 726 : SEGINI MEVOLL 727 : IPVO=MEVOLL 728 : TI(1:72)=TITREE 729 : IEVTEX=TI 730 : WRITE(TI(64:72),'(A5,I4)')INEWT 731 : ITYEVO='REEL' 732 : C 733 : SEGINI KEVOLL 734 : C 735 : WRITE(TI,100)AMOR 736 : 100 FORMAT(1X,'AMORTISSEMENT DE ',1PD12.5) 737 : KEVTEX=TI 738 : C 739 : IEVOLL(1)=KEVOLL 740 : TYPX='LISTREEL' 741 : TYPY='LISTREEL' 742 : C 743 : IPROGX=MLREE1 744 : NOMEVX=MOTX(1:12) 745 : C 746 : JG=NT 747 : SEGINI MLREE2 748 : IF(LPERIO)THEN 749 : DO 62 I=1,NT 750 : MLREE2.PROG(I)=RES(I) 751 : 62 CONTINUE 752 : ELSE 753 : DO 63 I=1,NT 754 : MLREE2.PROG(NT-I+1)=RES(I) 755 : 63 CONTINUE 756 : ENDIF 757 : SEGDES MLREE2 758 : IPROGY=MLREE2 759 : MOTY(11:12)=' 1' 760 : NOMEVY=MOTY(1:12) 761 : C 762 : NUMEVX=ICOUL 763 : NUMEVY='REEL' 764 : C 765 : SEGDES KEVOLL 766 : SEGDES MEVOLL 767 : C 768 : C 7) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE 769 : C 770 : SEGSUP MTRAV,MMTRA 771 : IF(LONDEL)THEN 772 : DO 890 IE1=1,NBFREQ 773 : C** SEGSUP, IMTK2(IE1) 774 : MLREK2 = IMTK2(IE1) 775 : SEGSUP,MLREK2 776 : 890 CONTINUE 777 : SEGSUP, MONDE 778 : ENDIF 779 : C 779 : CALL ECROBJ('EVOLUTIO',IPVO) 780 : C 781 : RETURN 782 : C 783 : 663 SEGSUP MONDE 784 : SEGDES MLREEL 785 : SEGDES KEVOLL 786 : 664 SEGDES MLREE1 787 : SEGDES KEVOL1 788 : SEGDES MEVOL1 789 : 665 SEGDES MEVOL2 790 : SEGDES MLREE3 791 : 666 CONTINUE 792 : RETURN 793 : END 794 : 795 : 796 : 797 : 798 : 799 : 800 : 801 : 802 :
© Cast3M 2003 - All rights reserved.
Disclaimer