C TFOR SOURCE CHAT 07/10/29 21:29:33 5940 SUBROUTINE TFOR(IOPT) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-V) IMPLICIT COMPLEX*16 (W-Z) CHARACTER *72 TI CHARACTER *24 MOTY CHARACTER *4 NSORT(2),MCLE(2) LOGICAL INV C C======================================================================= C = CALCUL DE LA TRANSFORMEE DE FOURIER RAPIDE D'UN SIGNAL = C = = C = SYNTAXE : = C = = C = TRANSFORMEE DE FOURIER DIRECTE (IOPT=-1) = C = FFTR = TFOR EXP2 EVO1 SORT FMIN V1 FMAX V2 (COU1) (COU2) ; = C = = C = TRANSFORMEE DE FOURIER INVERSE (IOPT=1) = C = FFTR = TFRI EXP2 EVO1 SORT FMIN V1 FMAX V2 (COU1) (COU2) ; = C = = C = = C = EXP2 : EXPOSANT DANS NPOINT=2^EXP2, NPOINT ETANT = C = LE NOMBRE DE REELS DANS LISTREEL = C = EVO1 : OBJET DE TYPE EVOLUTIO CONTENANT LE SIGNAL A TRAITER= C = SORT : TYPE DE SORTIE ; = C = = 'REIM' PART REEL & PART IMAG / FREQ = C = = 'MOPH' MODULE & PHASE / FREQ = C = FMIN : MOT-CLE = C = V1 : FREQUENCE MINIE A VISUALISER = C = FMAX : MOT-CLE = C = V2 : FREQUENCE MAXIE A VISUALISER = C = COU1 : COULEUR ATTRIBUEE A LA PREMIERE COURBE (FACULTATIF) = C = COU2 : COULEUR ATTRIBUEE A LA DEUXIEME COURBE (FACULTATIF) = C = = C = = C = CREATION : 16/04/87 = C = PROGRAMMEUR : BEAUFILS = C======================================================================= C -INC CCGEOME -INC CCOPTIO -INC SMEVOLL -INC SMLREEL C SEGMENT MTRAV1 IMPLIED XX(NCOU),YY(NCOU) ENDSEGMENT C SEGMENT MTRAV2 IMPLIED W(NEXP) ENDSEGMENT C DATA NSORT(1),NSORT(2)/'REIM','MOPH'/ DATA MCLE(1),MCLE(2)/'FMIN','FMAX'/ C C LECTURE DE EXP2 C CALL LIRENT(N2,1,IRET1) IF(IRET1.EQ.0)GOTO 666 C C LECTURE DE L'OBJET EVOLUTIO CONTENANT LE SIGNAL C CALL LIROBJ('EVOLUTIO',IPSIG,1,IRET2) IF(IRET2.EQ.0)GOTO 666 C C LECTURE DU TYPE DE SORTIE C CALL LIRMOT(NSORT,2,ISORT,0) IF(ISORT.EQ.0) ISORT=1 C C LECTURE DE LA FREQUENCE MINIE C CALL LIRMOT(MCLE(1),1,IRET,0) IF(IRET.EQ.1) THEN CALL LIRREE(FRMI,0,IRET1) IF(IRET1.EQ.0) THEN MOTERR(1:4)=MCLE(1)(1:4) CALL ERREUR(166) GOTO 666 ENDIF IF(FRMI.LT.(-1.D-20)) FRMI=-FRMI IF(ABS(FRMI).LT.1.D-20) FRMA=-1.D0 ELSE FRMI=-1.D0 ENDIF C C LECTURE DE LA FREQUENCE MAXIE C CALL LIRMOT(MCLE(2),1,IRET,0) IF(IRET.EQ.1) THEN CALL LIRREE(FRMA,0,IRET1) IF(IRET1.EQ.0) THEN MOTERR(1:4)=MCLE(2)(1:4) CALL ERREUR(166) GOTO 666 ENDIF IF(FRMA.LT.(-1.D-20)) FRMA=-FRMA IF(ABS(FRMA).LT.1.D-20) FRMA=-1.D0 ELSE FRMA=-1.D0 ENDIF C C LECTURE DE LA COULEUR C CALL LIRMOT(NCOUL,NBCOUL,ICOU1,0) IF (ICOU1.EQ.0) ICOU1=IDCOUL+1 ICOU1=ICOU1-1 CALL LIRMOT(NCOUL,NBCOUL,ICOU2,0) IF (ICOU2.EQ.0) ICOU2=IDCOUL+1 ICOU2=ICOU2-1 C IF(IERR.NE.0) GOTO 666 C MEVOL1=IPSIG SEGACT MEVOL1 KEVOL1=MEVOL1.IEVOLL(1) SEGACT KEVOL1 MLREE1=KEVOL1.IPROGX MLREE2=KEVOL1.IPROGY C SEGACT MLREE1,MLREE2 L1=MLREE1.PROG(/1) DT=MLREE1.PROG(2)-MLREE1.PROG(1) IF(DT.LE.0.) THEN CALL ERREUR(206) SEGDES MLREE1,MLREE2 SEGDES KEVOL1,MEVOL1 GO TO 666 ENDIF SEGDES MLREE1 C NPOINT=2**N2 IF(NPOINT.GT.L1) THEN IF(IIMPI.EQ.1) WRITE(IOIMP,1000) L1,N2,NPOINT 1000 FORMAT(1H ,'LE NOMBRE DE POINTS DANS LISTEMPS ',I6, ' EST ', & 'INFERIEURE @ 2**',I5, & /' ON PRENDRA UNE LONGUEUR DE LISTEMPS DE ',I6,' MOTS ', & /' ET ON COMPLETERA PAR DES ZEROS') ELSE IF(NPOINT.LT.L1) THEN IF(IIMPI.EQ.1) WRITE(IOIMP,1010) N2 1010 FORMAT(1H ,'ON TRONQUE LE SIGNAL A 2**',I5,' MOTS',/) ELSE IF(IIMPI.EQ.1) WRITE(IOIMP,1030)N2,NPOINT 1030 FORMAT(1H ,'LA LONGUEUR DU LISTEMP EST EGALE A 2**',I5, & ' = ',I6,/) ENDIF ENDIF NDIBLK=NPOINT C NCOU=NPOINT SEGINI MTRAV1 C NEXP=NPOINT/2 SEGINI MTRAV2 C C CHARGEMENT DES TABLEAUX DE TRAVAIL C IND1=L1 IF(NPOINT.LT.L1)IND1 = NPOINT DO 10 I=1,IND1 XX(I)=MLREE2.PROG(I) C IF(IIMPI.EQ.1)WRITE(IOIMP,*) ' XX(',I,') = ',XX(I) 10 CONTINUE IF(NPOINT.GT.L1) THEN L2=L1+1 DO 11 I=L2,NPOINT XX(I)=0. 11 CONTINUE ENDIF C C CALCUL DE LA FFT C IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CALCUL DE LA FFT DU SIGNAL ' IF (IOPT.EQ.-1) THEN INV=.FALSE. ELSE INV=.TRUE. ENDIF CALL WEXP(INV,NPOINT,W(1)) CALL FFTL(XX(1),YY(1),W(1),NPOINT) C IF(IIMPI.EQ.1) WRITE(IOIMP,*)' FFT CALCULEE ' SEGDES MLREE2 C C CREATION ET CALCUL DES LISTES DE LA FFT C IF(IIMPI.EQ.1) WRITE(IOIMP,*)' CHARGEMENT DE LA FFT ' DUREE=DT*DBLE(NPOINT) DFREQ=1.D0/DUREE KHALF=INT(NPOINT/2)+1 KMIN=INT(FRMI/DFREQ)+1 KMAX=INT(FRMA/DFREQ)+1 KDEBU=1 IF(KMIN.GT.0) KDEBU=KMIN IF((KMAX.LT.KHALF).AND.(FRMA.GT.0.D0)) KHALF=KMAX NNN=KHALF-KDEBU+1 JG=NNN SEGINI MLREE1 SEGINI MLREE2 SEGINI MLREE3 IF(IIMPI.EQ.1) WRITE(IOIMP,*)' SORTIE DE ',NNN,' POINTS ' IF(ISORT.EQ.1) THEN C C SORTIE EN PARTIE REELLE & IMAGINAIRE / FREQUENCE C DO 20 I=KDEBU,KHALF FREQ=DBLE(I-1)*DFREQ C IF(IIMPI.EQ.1) WRITE(IOIMP,*)I,FREQ,' XX = ',XX(I) ITY=I-KDEBU+1 MLREE1.PROG(ITY)=FREQ MLREE2.PROG(ITY)=DT*XX(I) MLREE3.PROG(ITY)=DT*CXTOIM(XX(I)) 20 CONTINUE MOTY(1:24)='PART REEL PART IMAG' ELSE C C SORTIE EN MODULE & PHASE / FREQUENCE C DO 21 I=KDEBU,KHALF FREQ=DBLE(I-1)*DFREQ C IF(IIMPI.EQ.1) WRITE(IOIMP,*)I,FREQ,' XX = ',XX(I) ITY=I-KDEBU+1 MLREE1.PROG(ITY)=FREQ PREEL=XX(I) PIMAG=CXTOIM(XX(I)) PMODU=SQRT(PREEL*PREEL+PIMAG*PIMAG) MLREE2.PROG(ITY)=DT*PMODU CALL FACOMP(PREEL,PIMAG,PMODU) MLREE3.PROG(ITY)=PMODU 21 CONTINUE MOTY(1:8)='MODULE' MOTY(9:12)=' ' MOTY(13:20)='PHASE' MOTY(21:24)=' ' ENDIF C SEGDES MLREE1,MLREE2,MLREE3 C C CREATION DE L'OBJET EVOLUTIO FFT C N=2 SEGINI MEVOLL IPVO=MEVOLL TI(1:72)=TITREE IEVTEX=TI ITYEVO='COMPLEXE' C C PREMIERE COURBE C SEGINI KEVOLL TYPX='LISTREEL' TYPY='LISTREEL' KEVTEX=TI IEVOLL(1)=KEVOLL C IPROGX=MLREE1 NOMEVX='FREQ HZ' C IPROGY=MLREE2 NOMEVY=MOTY(1:12) C NUMEVX=ICOU1 IF(ISORT.EQ.1) THEN NUMEVY='PREE' ELSE NUMEVY='MODU' ENDIF C SEGDES KEVOLL C C DEUXIEME COURBE C SEGINI KEVOLL TYPX='LISTREEL' TYPY='LISTREEL' KEVTEX=TI IEVOLL(2)=KEVOLL C IPROGX=MLREE1 NOMEVX='FREQ HZ' C IPROGY=MLREE3 NOMEVY=MOTY(13:24) C NUMEVX=ICOU2 IF(ISORT.EQ.1) THEN NUMEVY='PIMA' ELSE NUMEVY='PHAS' ENDIF C SEGDES KEVOLL C SEGSUP MTRAV1,MTRAV2 SEGDES KEVOL1,MEVOL1 C SEGDES MEVOLL CALL ECROBJ('EVOLUTIO',IPVO) 666 CONTINUE RETURN END