1 : C DSPR SOURCE CHAT 07/10/29 21:18:26 5940 2 : SUBROUTINE DSPR 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-V) 5 : IMPLICIT COMPLEX*16 (W-Z) 6 : CHARACTER *72 TI 7 : CHARACTER*12 MOTX,MOTY 8 : CHARACTER*4 MCLE(2) 9 : LOGICAL INV 10 : C 11 : C======================================================================= 12 : C = CALCUL DE LA DENSITE SPECTRALE DE PUISSANCE D'UN SIGNAL = 13 : C = = 14 : C = SYNTAXE : = 15 : C = = 16 : C = SPEC = DSPR EXP2 EVO1 FMIN V1 FMAX V2 (COUL) ; = 17 : C = = 18 : C = = 19 : C = EXP2 : EXPOSANT DANS NPOINT=2^EXP2, NPOINT ETANT = 20 : C = LE NOMBRE DE REELS DANS LISTREEL = 21 : C = EVO1 : OBJET DE TYPE EVOLUTIO CONTENANT LE SIGNAL A TRAITER= 22 : C = ( UNE COURBE SEULEMENT ) = 23 : C = FMIN : MOT-CLE = 24 : C = V1 : FREQUENCE MINIE A VISUALISER = 25 : C = FMAX : MOT-CLE = 26 : C = V2 : FREQUENCE MAXIE A VISUALISER = 27 : C = COUL : COULEUR ATTRIBUEE A L'OBJET CREE (FACULTATIF) = 28 : C = = 29 : C = = 30 : C = CREATION : 01/04/87 = 31 : C = PROGRAMMEUR : BEAUFILS = 32 : C = MODIFICATIO : PEG WARNING LE IRET2.... 22/2/90 = 33 : C = MODIFICATIO : PEG FREQUENCES CORRECTES 1/6/90 = 34 : C = MODIFICATIO : PEG PERIODOGRAM CORRECT 1/6/90 = 35 : C======================================================================= 36 : C 37 : -INC CCGEOME 38 : -INC CCOPTIO 39 : -INC SMEVOLL 40 : -INC SMLREEL 41 : C 42 : SEGMENT MTRAV1 43 : IMPLIED XX(NCOU),YY(NCOU) 44 : ENDSEGMENT 45 : C 46 : SEGMENT MTRAV2 47 : IMPLIED W(NEXP) 48 : ENDSEGMENT 49 : C 50 : DATA MOTX/'FREQ HZ'/ 51 : DATA MOTY/'DSP UN**2/HZ'/ 52 : DATA MCLE(1),MCLE(2)/'FMIN','FMAX'/ 53 : C 54 : C LECTURE DE EXP2 55 : C 55 : CALL LIRENT(N2,1,IRET1) 56 : IF(IRET1.EQ.0)GOTO 666 57 : C 58 : C LECTURE DE L'OBJET EVOLUTIO CONTENANT LE SIGNAL 59 : C 59 : CALL LIROBJ('EVOLUTIO',IPSIG,1,IRET2) 60 : C PEG IF(IRET1.EQ.0)GOTO 666 61 : IF(IRET2.EQ.0)GOTO 666 62 : C 63 : C LECTURE DE LA FREQUENCE MINIE 64 : C 64 : CALL LIRMOT(MCLE(1),1,IRET,0) 65 : IF(IRET.EQ.1) THEN 65 : CALL LIRREE(FRMI,0,IRET1) 66 : IF(IRET1.EQ.0) THEN 67 : MOTERR(1:4)=MCLE(1) 67 : CALL ERREUR(166) 68 : GOTO 666 69 : ENDIF 70 : IF(FRMI.LT.(-1.D-20)) FRMI=-FRMI 71 : IF(ABS(FRMI).LT.1.D-20) FRMI=-1.D0 72 : ELSE 73 : FRMI=-1.D0 74 : ENDIF 75 : C 76 : C LECTURE DE LA FREQUENCE MAXIE 77 : C 77 : CALL LIRMOT(MCLE(2),1,IRET,0) 78 : IF(IRET.EQ.1) THEN 78 : CALL LIRREE(FRMA,0,IRET1) 79 : IF(IRET1.EQ.0) THEN 80 : MOTERR(1:4)=MCLE(2) 80 : CALL ERREUR(166) 81 : GOTO 666 82 : ENDIF 83 : IF(FRMA.LT.(-1.D-20)) FRMA=-FRMA 84 : IF(ABS(FRMA).LT.1.D-20) FRMA=-1.D0 85 : ELSE 86 : FRMA=-1.D0 87 : ENDIF 88 : C 89 : C LECTURE DE LA COULEUR 90 : C 90 : CALL LIRMOT(NCOUL,NBCOUL,ICOUL,0) 91 : IF(ICOUL.EQ.0) ICOUL=IDCOUL+1 92 : ICOUL=ICOUL-1 93 : C 94 : IF(IERR.NE.0) GOTO 666 95 : C 96 : MEVOL1=IPSIG 97 : SEGACT MEVOL1 98 : KEVOL1=MEVOL1.IEVOLL(1) 99 : SEGACT KEVOL1 100 : MLREE1=KEVOL1.IPROGX 101 : MLREE2=KEVOL1.IPROGY 102 : SEGACT MLREE1,MLREE2 103 : C 104 : L1=MLREE1.PROG(/1) 105 : DT=MLREE1.PROG(2)-MLREE1.PROG(1) 106 : SEGDES MLREE1 107 : C 108 : NPOINT=2**N2 109 : IF(NPOINT.GT.L1) THEN 110 : IF(IIMPI.EQ.1) WRITE(IOIMP,1000) L1,N2,NPOINT 111 : 1000 FORMAT(1H ,'LE NOMBRE DE POINTS DANS LISTEMPS ',I6, ' EST ', 112 : & 'INFERIEURE @ 2**',I5, 113 : & /' ON PRENDRA UNE LONGUEUR DE LISTEMPS DE ',I6,' MOTS ', 114 : & /' ET ON COMPLETERA PAR DES ZEROS') 115 : ELSE 116 : IF(NPOINT.LT.L1) THEN 117 : IF(IIMPI.EQ.1) WRITE(IOIMP,1010) N2 118 : 1010 FORMAT(1H ,'ON TRONQUE LE SIGNAL A 2**',I5,' MOTS',/) 119 : ELSE 120 : IF(IIMPI.EQ.1) WRITE(IOIMP,1030)N2,NPOINT 121 : 1030 FORMAT(1H ,'LA LONGUEUR DU LISTEMP EST EGALE A 2**',I5, 122 : & ' = ',I6,/) 123 : ENDIF 124 : ENDIF 125 : C 126 : NCOU=NPOINT 127 : SEGINI MTRAV1 128 : C 129 : NEXP=NPOINT/2 130 : SEGINI MTRAV2 131 : C 132 : C CHARGEMENT DES TABLEAUX DE TRAVAIL 133 : C 134 : IND1=L1 135 : IF(NPOINT.LT.L1)IND1 = NPOINT 136 : DO 10 I=1,IND1 137 : XX(I)=MLREE2.PROG(I) 138 : C IF(IIMPI.EQ.1)WRITE(IOIMP,*) ' XX(',I,') = ',XX(I) 139 : 10 CONTINUE 140 : IF(NPOINT.GT.L1) THEN 141 : L2=L1+1 142 : DO 11 I=L2,NPOINT 143 : XX(I)=0.D0 144 : 11 CONTINUE 145 : ENDIF 146 : C 147 : C CALCUL DE LA FFT 148 : C 149 : IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE LA FFT DU SIGNAL ' 150 : INV=.FALSE. 150 : CALL WEXP(INV,NPOINT,W(1)) 150 : CALL FFTL(XX(1),YY(1),W(1),NPOINT) 151 : C 152 : IF(IIMPI.EQ.1) WRITE(IOIMP,*)' FFT CALCULEE ' 153 : SEGDES MLREE2 154 : C 155 : C CREATION ET CALCUL DES LISTES DE LA DSP 156 : C 157 : IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE LA DSP DU SIGNAL ' 158 : DUREE=DT*DBLE(NPOINT) 159 : DFREQ=1.D0/DUREE 160 : KHALF=NEXP+1 161 : CPP + 162 : KHALF1=KHALF 163 : CPP + 164 : KMIN=INT(FRMI/DFREQ)+1 165 : KMAX=INT(FRMA/DFREQ)+1 166 : KDEBU=1 167 : IF(KMIN.GT.0) KDEBU=KMIN 168 : IF((KMAX.LT.KHALF).AND.(FRMA.GT.0.)) KHALF=KMAX 169 : JG=KHALF-KDEBU+1 170 : SEGINI MLREE1 171 : SEGINI MLREE2 172 : CPP ! COEF=2.D0*DFREQ*DT*DT 173 : COEF= DFREQ*DT*DT 174 : DO 20 I=KDEBU,KHALF 175 : FREQ=DBLE(I-1)*DFREQ 176 : C IF(IIMPI.EQ.1) WRITE(IOIMP,*)I,FREQ,' XX = ',XX(I) 177 : MLREE1.PROG(I-KDEBU+1)=FREQ 178 : YCOMP=CONJG(XX(I)) 179 : PMODU2=XX(I)*YCOMP 180 : CPP + 181 : IF(I.NE.1.AND.I.NE.KHALF1)THEN 182 : YCOMP=CONJG(XX(NPOINT-I+2)) 183 : PMODU2=PMODU2+XX(NPOINT-I+2)*YCOMP 184 : ENDIF 185 : CPP + 186 : MLREE2.PROG(I-KDEBU+1)=COEF*PMODU2 187 : C IF(IIMPI.EQ.1) WRITE(IOIMP,*)'DSP(',I,')=',MLREE2.PROG(I) 188 : 20 CONTINUE 189 : C 190 : SEGDES MLREE1,MLREE2 191 : C 192 : C CREATION DE L'OBJET EVOLUTIO DSP 193 : C 194 : N=1 195 : SEGINI MEVOLL 196 : IPVO=MEVOLL 197 : TI(1:72)=TITREE 198 : IEVTEX=TI 199 : ITYEVO='REEL' 200 : SEGINI KEVOLL 201 : KEVTEX=TI 202 : IEVOLL(1)=KEVOLL 203 : TYPX='LISTREEL' 204 : TYPY='LISTREEL' 205 : C 206 : IPROGX=MLREE1 207 : NOMEVX=MOTX(1:12) 208 : C 209 : IPROGY=MLREE2 210 : NOMEVY=MOTY(1:12) 211 : C 212 : NUMEVX=ICOUL 213 : NUMEVY='REEL' 214 : C 215 : SEGSUP MTRAV1,MTRAV2 216 : SEGDES KEVOL1 217 : SEGDES MEVOL1 218 : C 219 : SEGDES KEVOLL,MEVOLL 219 : CALL ECROBJ('EVOLUTIO',IPVO) 220 : 666 CONTINUE 221 : RETURN 222 : END 223 : 224 : 225 : 226 : 227 : 228 : 229 : 230 :
© Cast3M 2003 - All rights reserved.
Disclaimer