C PRNS SOURCE OF166741 25/02/20 21:17:27 12165 C PRNS SOURCE ISPRA 90/05/03 SUBROUTINE PRNS IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C======================================================================= C = CALCUL DU "RESPONSE SPECTRUM" A PARTIR DU "POWER SPECTRUM" = C = DANS LE CAS NON STATIONNAIRE = C = = C = SYNTAXE : = C = = C = RSNS*EVOL = PRNS PSNS*EVOL = C = M *EVOL FREQ*LISTREEL = C = (TT*LISTREEL AMOR*FLOTTANT = C = MCL1*MOT MCL2*MOT MCL3*MOT = C = COUL*MOT = C = MCL4*MOT NUM*ENTIER = C = MCL5*MOT DTBASE*FLOTTANT ) = C = = C = = C = RSNS : OBJET DE TYPE EVOLUTIO CONTENANT LES = C = "RESPONSE SPECTRA" (1 COURBE) = C = = C = PSPE : OBJET DE TYPE EVOLUTIO CONTENANT LE "POWER SPECTRUM"= C = ( UNE COURBE SEULEMENT ) = C = = C = M : OBJET DE TYPE EVOLUTIO CONTENANT N COURBES = C = D'EVOLUTIONS TEMPORELLE (LES TEMPS FINALS DOIVENT = C = ETRE IDENTIQUES) = C = = C = FREQ : OBJET DE TYPE LISTREEL CONTENANT N+1 FREQUENCES = C = (FREQ"(I)" ET FREQ"(I+1)" DEFINISSENT LA BANDE DE = C = VALIDITE DE M"(I)") = C = = C = TT : OBJET DE TYPE LISTREEL CONTENANT LES PERIODES = C = AMOR : OBJET DE TYPE FLOTTANT CONTENANT L'AMORTISSEMENT = C = MCL1 : GRANDEUR DE REPONSE: 'DEPL(ACEMENT)', 'VITE(SSE)' = C = OU 'ACCE(LERATION)' (DEFAUT) = C = MCL2 : CHOIX DE L'ABSISSE DU "RESPONSE SPECTRUM" = C = 'FREQ(UENCE)' OU 'PERI(ODE)' (DEFAUT) = C = DANS LES 2 CAS LES VALEURS SONT RANGEES PAR VALEURS = C = CROISSANTES DES ABSCISSES (UTILATION DE IPOL!) = C = MCL3 : CHOIX DE LA DISTRIBUTION: 'NEG1' = C = OU 'NEG2' (DEFAUT) = C = COUL : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF) = C = ( DEFAUT = COULEUR DE PSNL) = C = MCL4 : INTEGRATION NEWMARK: = C = 'NBPR(OCESSUS)' + NUM = NB PROCESSUS STATIONAIRES = C = 'NBIN(TEGRATION)'+ NUM = NB PTS D'INTEGRATION EN T = C = 'PREC(ISION)'+ ERR = ERREUR PROC. ITERATIFS = C = 'TPLU(S)' + TPL = TEMPS EN PLUS = C = 'NBDE(FAUT)' = VALEURS PAR DEFAUT = C = MCL5 : CALCUL PAR ONDELETTE = C = 'ONDE' AVEC FCT DE MODULATION CLASSIQUE = C = OU AVEC COEFF EN ONDELETTE = C = = C = CREATION : creation 3/5/90 = C = MODIF ONDEL : 24/9/90 = C = DPI NON EGAL A 8*TAN(1.) !!!!: 24/1/91 = C = AJOUT DE 20 S A LA DUREE : 29/1/91 = C = MESSAGE D'ERREUR : 15/9/91 = C = PROGRAMMEUR : P.P. = C======================================================================= C CHARACTER *72 TI CHARACTER*12 MOTX,MOTY C PARAMETER (NMOCLE=13) CHARACTER*4 MOTCLE(NMOCLE) LOGICAL LPERIO,LUSER LOGICAL LONDEL C -INC CCGEOME -INC PPARAM -INC CCOPTIO -INC SMEVOLL -INC SMLREEL POINTEUR MLREK2.MLREEL C DIMENSION XLTI(3) SEGMENT MTRAV INTEGER IFREQ(2,NBFREQ) REAL*8 F(NSPTOM),S(NSPTOM), T(NT), RES(NT) REAL*8 XLSTAT(3,NBFREQ) REAL*8 XMTK2(NBFREQ,IPROC) C REAL*8 XLTIME(NTIME,3) ENDSEGMENT C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== SEGMENT,MMTRA REAL*8 XLTIME(NNT,3) ENDSEGMENT C======+++++++++++ bon fontionnement erreur PSRS/PRNS +++++++++++ ====== SEGMENT MONDE REAL*8 XPAS(NBFREQ) c* POINTEUR IMTK2(NBFREQ).MLREEL INTEGER IMTK2(NBFREQ) ENDSEGMENT C C 1) LECTURE DES DONNEES GIBIANE C C 1.1) LISTE DES MOTS CLEF C DATA MOTCLE/'PERI','FREQ','ACCE','VITE','DEPL', > 'NBDE','NBPR','NBIN','PREC','NEG1','NEG2', > 'ONDE','TPLU'/ C C 1.2) DEFAUTS C (MCLE: "'PERI'->LPERIO, 'ACCE'->KGRAND, 'NEWG'->IDISTR) C LPERIO=.TRUE. KGRAND=1 IDISTR=2 C IPROC=0 IINT=0 AMOR=0.05D0 XRREUR=1.D-3 TPL=20.D0 C LONDEL=.FALSE. C C 1.3) LECTURE DE L'OBJET EVOLUTIO CONTENANT LE "POWER SPECTRUM" C CALL LIROBJ('EVOLUTIO',IPPS,1,IRET) IF(IRET.EQ.0) GOTO 666 C C 1.4) LECTURE DE L'OBJET EVOLUTIO CONTENANT LES FONCTIONS DE MODULATIONS C CALL LIROBJ('EVOLUTIO',IPMOD,1,IRET) IF(IRET.EQ.0) GOTO 666 C C 1.5) LECTURE DE L'OBJET LISTREEL CONTENANT LES FREQUENCES C CALL LIROBJ('LISTREEL',IPFRE,1,IRET) IF(IRET.EQ.0) GOTO 666 C C 1.6) LECTURE DE L'OBJET LISTREEL DONNANT LE TABLEAU DES PERIODES C DEFINI PAR L'UTILISATEUR (OPTIONEL) C CALL LIROBJ('LISTREEL',IPREET,0,IRET) IF(IRET.EQ.0)THEN LUSER=.FALSE. ELSE LUSER=.TRUE. ENDIF C C 1.7) LECTURE DU REEL DONNANT L'AMORTISSEMENT (OPTIONEL) C CALL LIRREE(AMOR1,0,IRET) IF(IRET.NE.0)THEN AMOR=AMOR1 ENDIF C C 1.8) LECTURE DES MOTS MCL1, MCL2, MCL3, MCL4 ...ET DE LA COULEUR C (OPTIONEL) C * 1 CALL LIRMO2(MOTCLE,NMOCLE,IVAL, * > NCOUL ,NBCOUL,ICOUL,0) C 1 CALL LIRMOT(MOTCLE,NMOCLE,IVAL,0) CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0) if (icoul.eq.0) icoul=idcoul+1 icoul=icoul-1 C IF(IVAL.EQ.0)GOTO 9 GOTO(2,3,4,4,4,1,5,6,7,8,8,881,882),IVAL C ---> "MCL2" 2 LPERIO=.TRUE. GOTO 1 3 LPERIO=.FALSE. GOTO 1 C ---> "MCL1" 1->ACCE, 2->VITE, 3->DEPL 4 KGRAND=IVAL-2 GOTO 1 C ---> "MCL4" 1->NBDE, 2->NBPR, 3->NBIN 5 CALL LIRENT(IPROC,1,IRET) IF(IRET.EQ.0) GOTO 666 GOTO 1 6 CALL LIRENT(IINT,1,IRET) IF(IRET.EQ.0) GOTO 666 GOTO 1 7 CALL LIRREE(XRREUR,1,IRET) IF(IRET.EQ.0) GOTO 666 GOTO 1 C ---> "MCL3" 1->NEG1, 2->NEG2 8 IDISTR=IVAL-9 GOTO 1 C ---> "MCL5" ONDELETTE... 881 LONDEL=.TRUE. CALL LIRREE(DTBASE,1,IRET) IF(IRET.EQ.0) GOTO 666 GOTO 1 C ---> "MCL4" 4->TPL 882 CALL LIRREE(TPL,1,IRET) IF(IRET.EQ.0) GOTO 666 GOTO 1 C C 1.9) "LECTURE" DE LA COULEUR C 9 IF(ICOUL.NE.0)GOTO 1 C IF(IERR.NE.0) GOTO 666 C WRITE(IOIMP,*)'FIN LECTURE' C C 2) VERIFICATION DE LA COHERENCE DES DONNEES M, FREQ ET PSNS C C 2.1) NB DE COURBE/NB D'INTERVALLE DE FREQUENCE C MEVOL2=IPMOD SEGACT MEVOL2 NBFREQ=MEVOL2.IEVOLL(/1) MLREE3=IPFRE SEGACT MLREE3 NBFRE1=MLREE3.PROG(/1) -1 IF(NBFREQ.NE.NBFRE1)THEN CALL ERREUR(578) GOTO 665 ENDIF C C 2.2) DEBUT ET FIN DES FONCTIONS DE MODULATION C KEVOLL=MEVOL2.IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL TINI=PROG(1) TFIN=PROG(PROG(/1)) SEGDES MLREEL SEGDES KEVOLL IF (NBFREQ.GT.1)THEN DO 10 IE1=2,NBFREQ KEVOLL=MEVOL2.IEVOLL(IE1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL TINI1=PROG(1) TFIN1=PROG(PROG(/1)) SEGDES MLREEL SEGDES KEVOLL IF((ABS(TINI-TINI1)+ABS(TFIN-TFIN1)).GT.1.D-5)THEN CALL ERREUR(579) GOTO 665 ENDIF 10 CONTINUE ENDIF TE=TFIN-TINI C C 2.3) INTERVALLE DE FREQUENCE DU SPECTRE DE PUISSANCE C FRMI=MLREE3.PROG(1) FRMA=MLREE3.PROG(NBFREQ+1) MEVOL1=IPPS SEGACT MEVOL1 KEVOL1=MEVOL1.IEVOLL(1) SEGACT KEVOL1 C IF(ICOUL.EQ.0) ICOUL=KEVOL1.NUMEVX C MLREE1=KEVOL1.IPROGX MLREE2=KEVOL1.IPROGY SEGACT MLREE1 FRMI1=MLREE1.PROG(1) NBSPEC=MLREE1.PROG(/1) FRMA1=MLREE1.PROG(NBSPEC) IF(.NOT.LONDEL)THEN IF ((ABS(FRMI-FRMI1)+ABS(FRMA-FRMA1)).GT.1.D-5)THEN CALL ERREUR(580) GOTO 664 ENDIF ENDIF C C 2.4) VERIFICATION SPECIFIQUE DU CALCUL EN ONDELETTE C -NB DE BANDE DE FREQUENCE C -REPARTITION DES BANDES PAR OCTAVE C -DETERMINATION DU PAS DE TEMPS D'IDENTIFICATION C IF(LONDEL)THEN C IF(NBSPEC.NE.NBFREQ)THEN CALL ERREUR(581) GOTO 664 ENDIF C FREQBA=MLREE3.PROG(2) FREQB=FREQBA DO 800 IE1=2,NBFREQ FFREQ=MLREE3.PROG(IE1+1)-MLREE3.PROG(IE1) IF (ABS(FFREQ-FREQB)/FREQB.GT.1.D-5)THEN CALL ERREUR(582) GOTO 664 ENDIF FREQC=3*FREQB/2 IF(ABS(MLREE1.PROG(IE1)-FREQC)/FREQC.GT.1.D-5)THEN CALL ERREUR(583) GOTO 664 ENDIF FREQB=FREQB*2 800 CONTINUE C SEGINI, MONDE DDXMXP=0.D0 DO 805 IE1=1,NBFREQ KEVOLL=MEVOL2.IEVOLL(IE1) SEGACT KEVOLL MLREEL=IPROGX SEGACT MLREEL DDXMAX=0.D0 DO 801 IE2=2,PROG(/1) DDMMA=PROG(IE2)-PROG(IE2-1) IF(DDMMA.GT.DDXMAX)DDXMAX=DDMMA 801 CONTINUE ITE=INT(TE/DDXMAX+1.D-5) TTEST=TE-ITE*DDXMAX ITE=INT(DDXMXP/DDXMAX+1.D-5) TTEST=TTEST+DDXMXP-ITE*DDXMAX IF((ABS(TTEST).GT.2.D-5).OR.(ITE.GT.2))THEN INTERR(1)=IE1 CALL ERREUR(584) DDXMAX=0.D0 DO 802 IE2=2,PROG(/1) DDXMAX=DDXMAX+(PROG(IE2)-PROG(IE2-1)) ITE=INT(TE/DDXMAX+1.D-5) TTEST=TE-ITE*DDXMAX ITE=INT(DDXMXP/DDXMAX+1.D-5) TTEST=TTEST+DDXMXP-ITE*DDXMAX IF((ABS(TTEST).LE.2.D-5).AND.(ITE.LE.2))GOTO 803 802 CONTINUE CALL ERREUR(485) GOTO 663 803 CONTINUE ENDIF XPAS(IE1)=DDXMAX DDXMXP=DDXMAX SEGDES MLREEL SEGDES KEVOLL 805 CONTINUE C ENDIF C WRITE(IOIMP,*)'FIN VERIFICATION DES DONNEES' C C 3) CALCUL DES BORNES DE LA ZONE DE TRAVAIL C C SPECTRE DE PUISSANCE + BORNE DE FREQUENCE C NOMBRE D'OSCILLATEUR POUR LA REPONSE C NOMBRE DE POINT D'EVALUATION EN TEMPS C NSPT=MLREE1.PROG(/1) NSPTOM=NSPT+NBFREQ-1 C IF(LONDEL)NSPTOM=NSPTOM+1 C IF (LUSER)THEN MLREEL=IPREET SEGACT MLREEL NT=PROG(/1) SEGDES MLREEL ELSE NT=75 ENDIF C IF (IPROC.EQ.0)THEN IPROC=INT((TE-1.D-5)/2)+1 ENDIF IF (IINT.EQ.0)THEN IINT=10 ENDIF NTIME=IPROC*IINT+1 IF(LONDEL)THEN NNTIME=INT(TE/XPAS(NBFREQ)+1.D-5)+1 IF(NNTIME.LT.NTIME)THEN MMULT=INT(LOG(DBLE((NTIME-1)/(NNTIME-1)))/LOG(2.D0)+1.D-5) MMULT=2**MMULT NTIME=MMULT*(NNTIME-1)+1 IPROC=1 ELSE NTIME=NNTIME ENDIF ENDIF DTIME=TE/(NTIME-1) C NTIMEP=INT(TPL/DTIME +1.D-5) NTIME=NTIME+NTIMEP C WRITE(IOIMP,*)'FIN CALCUL DES BORNES DE LA ZONE DE TRAVAIL' C C 4) REMPLISSAGE DES TABLEAUX DE TRAVAIL C NNT=NTIME SEGINI,MTRAV,MMTRA C C 4.1) INDICE MIN/MAX DES BANDES DE FREQUENCE (ON PREVOIT D'INTERCALER C DES POINTS) C CALCUL DU NOMBRE DE POINT POUR F ET S C CHARGEMENT DES POINTS POUR F ET S C SEGACT MLREE2 C IF(LONDEL)THEN C DO 810 IE1=1,NBFREQ IFREQ(1,IE1)=2*IE1-1 IFREQ(2,IE1)=2*IE1 F(2*IE1-1) =MLREE3.PROG(IE1) F(2*IE1 ) =MLREE3.PROG(IE1+1) S(2*IE1-1) =MLREE2.PROG(IE1) S(2*IE1 ) =MLREE2.PROG(IE1) 810 CONTINUE C ELSE C IFREQ(1,1)=1 IF(NBFREQ.EQ.1)THEN IFREQ(2,1)=NSPT NSPTOT=NSPT DO 101 IE1=1,NSPTOT F(IE1)=MLREE1.PROG(IE1) S(IE1)=MLREE2.PROG(IE1) 101 CONTINUE ELSE IESP=2 IPTSUP=0 F(1)=MLREE1.PROG(1) S(1)=MLREE2.PROG(1) DO 13 IE1=2,NBFREQ FRM =MLREE3.PROG(IE1) DO 11 IE3=1,NSPT FRPS=MLREE1.PROG(IESP) IF(FRPS.GT.(FRM-1.D-5)) GOTO 12 F(IESP+IPTSUP)=FRPS S(IESP+IPTSUP)=MLREE2.PROG(IESP) IESP=IESP+1 11 CONTINUE 12 IF(FRPS.GT.(FRM+1.D-5))THEN F(IESP+IPTSUP)=FRM S(IESP+IPTSUP)=MLREE2.PROG(IESP) > - (FRPS-FRM)/(FRPS-MLREE1.PROG(IESP-1)) > *(MLREE2.PROG(IESP)-MLREE2.PROG(IESP-1)) IFREQ(2,IE1-1)=IESP+IPTSUP IFREQ(1,IE1 )=IESP+IPTSUP IPTSUP=IPTSUP+1 ELSE F(IESP+IPTSUP)=FRPS S(IESP+IPTSUP)=MLREE2.PROG(IESP) IFREQ(2,IE1-1)=IESP+IPTSUP IFREQ(1,IE1 )=IESP+IPTSUP IESP=IESP+1 ENDIF 13 CONTINUE NSPTOT=NSPT+IPTSUP IFREQ(2,NBFREQ)=NSPTOT DO 14 IE1=IESP,NSPT F(IE1+IPTSUP)=MLREE1.PROG(IE1) S(IE1+IPTSUP)=MLREE2.PROG(IE1) 14 CONTINUE ENDIF C ENDIF C SEGDES MLREE1 SEGDES MLREE2 SEGDES MEVOL1 SEGDES MLREE3 C C 4.1-BIS) INDICE MIN, LARGEUR DE BANDE DANS IFREQ C DO 15 IE1=1,NBFREQ IFREQ(2,IE1)=IFREQ(2,IE1)-IFREQ(1,IE1) + 1 15 CONTINUE C C 4.2) ON REMPLIT LE TABLEAU DES PERIODES C IF (LUSER)THEN MLREEL=IPREET SEGACT MLREEL DO 20 I=1,NT T(I)=PROG(I) 20 CONTINUE SEGDES MLREEL ELSE TINF=.04D0 UNPXI=EXP((LOG(TE)-LOG(TINF))/(NT-1)) T(1)=TINF DO I=2,NT T(I)=T(I-1)*UNPXI ENDDO T(NT)=TE ENDIF C C 4.3) ON REMPLIT XLTIME (INTERPOLATION DES MK A TR) C IF(LONDEL)THEN C DDT=DTBASE DO 817 IE1=1,NBFREQ KEVOLL=MEVOL2.IEVOLL(IE1) SEGACT, KEVOLL MLREE1=IPROGX MLREE2=IPROGY SEGACT, MLREE1,MLREE2 DDXMAX=XPAS(IE1) NNNI=INT(DDXMAX/DDT+1.D-5) JG=INT(TE/DDXMAX+1.D-5) C** SEGINI, IMTK2(IE1) SEGINI,MLREK2 IMTK2(IE1) = MLREK2 TR=TINI INDICE=2 XTIN=MLREE1.PROG(INDICE-1) XTOU=MLREE1.PROG(INDICE) XMIN=MLREE2.PROG(INDICE-1) RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) DO 816 IE2=1,JG VMTK2=0.D0 DO 815 IE3=1,NNNI TR=TR+DDT IF (TR.GT.(XTOU+1.E-5))THEN INDICE=INDICE+1 XTOU=MLREE1.PROG(INDICE) XTIN=MLREE1.PROG(INDICE-1) XMIN=MLREE2.PROG(INDICE-1) RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) ENDIF VMTK2=VMTK2+(XMIN + RATE *(TR-XTIN))**2 815 CONTINUE C** IMTK2(IE1).PROG(IE2)=VMTK2/NNNI MLREK2.PROG(IE2)=VMTK2/NNNI 816 CONTINUE IF(IE1.GT.1)DDT=DDT/2 SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL 817 CONTINUE C ELSE C DPROC=TE/IPROC DO 26 IE1=1,NBFREQ KEVOLL=MEVOL2.IEVOLL(IE1) SEGACT KEVOLL MLREE1=IPROGX MLREE2=IPROGY SEGACT MLREE1 SEGACT MLREE2 INDICE=2 XTIN=MLREE1.PROG(INDICE-1) XTOU=MLREE1.PROG(INDICE) XMIN=MLREE2.PROG(INDICE-1) RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) DO 25 IE2=1,IPROC TR=TINI+(IE2-0.5D0)*DPROC IF (TR.GT.(XTOU+1.E-5))THEN DO 251 IE3=INDICE,MLREE1.PROG(/1) INDICE=INDICE+1 XTOU=MLREE1.PROG(INDICE) IF (TR.LE.(XTOU+1.E-5))GOTO 252 251 CONTINUE 252 XTIN=MLREE1.PROG(INDICE-1) XMIN=MLREE2.PROG(INDICE-1) RATE=(MLREE2.PROG(INDICE)-XMIN)/(XTOU-XTIN) ENDIF XMTK2(IE1,IE2)=(XMIN + RATE *(TR-XTIN))**2 25 CONTINUE SEGDES MLREE1 SEGDES MLREE2 SEGDES KEVOLL 26 CONTINUE C ENDIF C SEGDES MEVOL2 C C 5) CALCUL C C 5.1) BOUCLE SUR LES PERIODES C INEWT=0 C DPI=8.D0*ATAN(1.D0) DO 50 IE1=1,NT FRQ=1/T(IE1) WN=FRQ*DPI C WRITE(IOIMP,*)'BOUCLE PERIODE IT ',IE1 C C 5.2) CALCUL DES MOMENTS STATIQUES C DO 30 IE2=1,NBFREQ CALL MOMENT(FRQ,AMOR,TE, > IFREQ(2,IE2),F(IFREQ(1,IE2)),S(IFREQ(1,IE2)) ,KGRAND, > XLSTAT(1,IE2),XLSTAT(2,IE2),XLSTAT(3,IE2) ) 30 CONTINUE C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS STATIQUES' C C 5.3) CALCUL DES MOMENT AU COURS DU TEMPS C PAR CONTRIBUTION DES PROCESSUS ELEMENTAIRES C C 5.3.1) MISE A ZERO C DO IE2=1,3 DO IE3=1,NTIME XLTIME(IE3,IE2)=0.D0 enddo enddo C IF(.NOT.LONDEL)THEN C C 5.3.2) BOUCLE SUR LES PROCESSUS C ROTMA=1-EXP(-2*WN*AMOR*DPROC) DO 40 IE2=1,IPROC TPROCD=TINI + (IE2-1)*DPROC TPROCF=TPROCD+DPROC C C 5.3.3) SOMME M(TK)*S*H DO IE3=1,3 XLTI(IE3)=0.D0 DO IE4=1,NBFREQ XLTI(IE3)=XLTI(IE3) + XMTK2(IE4,IE2)*XLSTAT(IE3,IE4) enddo enddo C C 5.3.4) FONCTION DE PONDERATION DE H... C INDOC=(IE2-1)*IINT + 1 INDOCM=INDOC+IINT DO IE3=INDOC,NTIME TTDT=(IE3-1)*DTIME INDT=IE3 IF (INDT.LE.INDOCM)THEN ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD)) ELSE ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF)) > -EXP(-2*WN*AMOR*(TTDT-TPROCD)) C IF((ROT/ROTMA).LT.1.D-3)GOTO 40 C ENDIF C 5.3.5) ... ET CONTRIBUTION LAMBDA(T) C DO IE4=1,3 XLTIME(INDT,IE4)=XLTIME(INDT,IE4)+ > ROT*XLTI(IE4) enddo enddo 40 CONTINUE C ELSE C C C 5.3.2.o) BOUCLE SUR LES FREQUENCE C DO 823 IE2=1,NBFREQ C* IPROC=IMTK2(IE2).PROG(/1) MLREK2 = IMTK2(IE2) IPROC = MLREK2.PROG(/1) DPROC=XPAS(IE2) IINT=INT(DPROC/DTIME+1.D-5) ROTMA=1-EXP(-2*WN*AMOR*DPROC) C C 5.3.2.o) BOUCLE SUR LES PROCESSUS C DO 822 IE3=1,IPROC TPROCD=TINI + (IE3-1)*DPROC TPROCF=TPROCD+DPROC C C 5.3.3.o) PRODUIT M(TK)*S*H C SI2I3 = MLREK2.PROG(IE3) DO 820 IE4=1,3 C** XLTI(IE4)=IMTK2(IE2).PROG(IE3)*XLSTAT(IE4,IE2) XLTI(IE4) = SI2I3 * XLSTAT(IE4,IE2) 820 CONTINUE C C 5.3.4.o) FONCTION DE PONDERATION DE H... C INDOC=(IE3-1)*IINT + 1 INDOCM=INDOC+IINT DO IE4=INDOC,NTIME TTDT=(IE4-1)*DTIME INDT=IE4 IF (INDT.LE.INDOCM)THEN ROT=1-EXP(-2*WN*AMOR*(TTDT-TPROCD)) ELSE ROT=EXP(-2*WN*AMOR*(TTDT-TPROCF)) > -EXP(-2*WN*AMOR*(TTDT-TPROCD)) C IF((ROT/ROTMA).LT.1.D-3)GOTO 822 C ENDIF C 5.3.5.o) ... ET CONTRIBUTION LAMBDA(T) C DO IE5=1,3 XLTIME(INDT,IE5)=XLTIME(INDT,IE5)+ > ROT*XLTI(IE5) ENDDO ENDDO 822 CONTINUE 823 CONTINUE C ENDIF C WRITE(IOIMP,*)'BOUCLE PERIODE CALCUL DES MOMENTS EN TEMPS' C C 5.4) CALCUL DU RESPONSE SPECTRA C CALL DISTRT(MMTRA, NTIME, DTIME, DPI, > TE, IDISTR,XRREUR, VALMAX ,IOK ,INEW) RES(IE1)=VALMAX IF(IOK.NE.0)THEN IF(IOK.LT.100)THEN SEGSUP MTRAV,MMTRA GOTO 666 ENDIF ENDIF C INEWT=INEWT+INEW 50 CONTINUE C WRITE(IOIMP,*)'FIN CALCUL DES RESULTATS' C IF(IIMPI.EQ.1)WRITE(IOIMP,*)'NB DE CALCUL DE LA DISTRIBUTION=' > ,INEWT C C 6) STOCKAGE DES RESULTAT C C 6.1) ABSISSE EN PERIODE OU EN FREQUENCE C IF(LPERIO.AND.LUSER)THEN MLREE1=IPREET MOTX='PERIODE' ELSE JG=NT SEGINI MLREE1 IF(LPERIO)THEN DO 60 I=1,NT MLREE1.PROG(I)=T(I) 60 CONTINUE MOTX='PERIODE' ELSE DO 61 I=1,NT MLREE1.PROG(NT-I+1)=1/T(I) 61 CONTINUE MOTX='FREQUENCE' ENDIF SEGDES MLREE1 ENDIF C C 6.2) LEGENDE (PARTIELLE) DES ORDONNEES C MOTY(1:10)='RSPE-'//MOTCLE(2+KGRAND)//' ' C C 6.3) CREATION DE L'OBJET EVOLUTIO RSNS C N=1 SEGINI MEVOLL IPVO=MEVOLL TI(1:72)=TITREE IEVTEX=TI WRITE(TI(64:72),'(A5,I4)')INEWT ITYEVO='REEL' C SEGINI KEVOLL C WRITE(TI,100)AMOR 100 FORMAT(1X,'AMORTISSEMENT DE ',1PD12.5) KEVTEX=TI C IEVOLL(1)=KEVOLL TYPX='LISTREEL' TYPY='LISTREEL' C IPROGX=MLREE1 NOMEVX=MOTX(1:12) C JG=NT SEGINI MLREE2 IF(LPERIO)THEN DO 62 I=1,NT MLREE2.PROG(I)=RES(I) 62 CONTINUE ELSE DO 63 I=1,NT MLREE2.PROG(NT-I+1)=RES(I) 63 CONTINUE ENDIF SEGDES MLREE2 IPROGY=MLREE2 MOTY(11:12)=' 1' NOMEVY=MOTY(1:12) C NUMEVX=ICOUL NUMEVY='REEL' C SEGDES KEVOLL SEGDES MEVOLL C C 7) DESTRUCTION DE LA ZONE DE TRAVAIL ET RETOUR A GIBIANE C SEGSUP MTRAV,MMTRA IF(LONDEL)THEN DO 890 IE1=1,NBFREQ C** SEGSUP, IMTK2(IE1) MLREK2 = IMTK2(IE1) SEGSUP,MLREK2 890 CONTINUE SEGSUP, MONDE ENDIF C CALL ECROBJ('EVOLUTIO',IPVO) C RETURN C 663 SEGSUP MONDE SEGDES MLREEL SEGDES KEVOLL 664 SEGDES MLREE1 SEGDES KEVOL1 SEGDES MEVOL1 665 SEGDES MEVOL2 SEGDES MLREE3 666 CONTINUE RETURN END