C TFRINV    SOURCE    CHAT      05/01/13    03:37:11     5004           
      SUBROUTINE TFRINV                                                         
C                                                                               
C=======================================================================        
C  =  CALCUL DE LA TRANSFORMEE DE FOURIER INVERSE D'UN SIGNAL                   
C  =                                                                            
C  =  SYNTAXE :             FFTR = TFRI    EVOL    ;                            
C  =                                                                            
C  =    EVOL    : OBJET DE TYPE EVOLUTIO CONTENANT L'OBJET EVOLUTION            
C  =                                                                  =         
C  =  CREATION    : 26/04/88                                          =         
C  =  F. ROULLIER                                                               
C=======================================================================        
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)                                                 
      CHARACTER *72 TI                                                          
      CHARACTER *4  ITYP1                                                       
      COMPLEX*16 RLTOCX                                                         
      LOGICAL INV                                                               
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
C                                                                               
      SEGMENT COMPL                                                             
          COMPLEX*16 XX(NPT),YY(NPT),W(NEXP)                                    
          REAL*8 AX(NPT),AR(NPT),AI(NPT),AM(NPT),AP(NPT)                        
          IMPLIED DX(NPT),DR(NPT),DI(NPT),DM(NPT),DP(NPT)                       
      ENDSEGMENT                                                                
C                                                                               
C     LECTURE DE L'OBJET EVOLUTION COMPLEXE A TRANSFORMER                       
C                                                                               
      CALL LIROBJ('EVOLUTIO',IEV1,1,IRETOU)                                     
      IF(IERR.NE.0) RETURN                                                      
C                                                                               
      MEVOLL=IEV1                                                               
      SEGACT MEVOLL                                                             
           IF (ITYEVO.NE.'COMPLEXE') THEN                                       
           MOTERR(1:8)='EVOLUTION'                                              
           SEGDES MEVOLL                                                  
           CALL ERREUR (302)                                                    
           RETURN                                                               
           ENDIF                                                                
      KEVOL1=IEVOLL(1)                                                          
      KEVOL2=IEVOLL(2)                                                          
      SEGACT KEVOL1,KEVOL2                                                      
      ITYP1=KEVOL1.NUMEVY                                                       
      ICOU1=KEVOL1.NUMEVX                                                       
      MLREE3=KEVOL1.IPROGX                                                      
      MLREE1=KEVOL1.IPROGY                                                      
      MLREE2=KEVOL2.IPROGY                                                      
C                                                                               
      SEGACT MLREE1,MLREE2,MLREE3                                               
      L1=MLREE3.PROG(/1)                                                        
      DF=MLREE3.PROG(2)-MLREE3.PROG(1)                                          
      SEGDES MLREE3                                                       
C                                                                               
      NPT=(L1-1)*2                                                              
      NP=NPT                                                                    
      NN=0                                                                      
      DO 1 I=1,1000                                                             
      NP=NP/2                                                                   
      NN=NN+1                                                                   
      IF (NP.LE.1) GO TO 2                                                      
    1 CONTINUE                                                                  
    2 NP=2**NN                                                                  
      IF (NP.NE.NPT) THEN                                                       
             WRITE(IOIMP,1000)                                                  
 1000        FORMAT(1H ,' NOMBRE DE POINTS INCORECT      ',3I6)                 
             CALL ERREUR (21)                                                   
             SEGDES MEVOLL,KEVOL1,KEVOL2                      
             SEGDES MLREE1,MLREE2                                   
             RETURN                                                             
      ENDIF                                                                     
C                                                                               
      NEXP=NPT/2                                                                
      NPOIN=L1                                                                  
      SEGINI COMPL                                                              
C                                                                               
C     CHARGEMENT DES TABLEAUX DE TRAVAIL                                        
C                                                                               
      IF (ITYP1.NE.'PREE') THEN                                                 
           DO 8 I=1,L1                                                          
           DM(I)=MLREE1.PROG(I)                                                 
           DP(I)=MLREE2.PROG(I)                                                 
    8      CONTINUE                                                             
           CALL CONVCP(DR,DI,DM,DP,L1,-1)                                       
           DO 7 I=1,L1                                                          
           AR(I)=DR(I)                                                          
           AI(I)=DI(I)                                                          
    7      CONTINUE                                                             
        ELSE                                                                    
           DO 9 I=1,L1                                                          
           AR(I)=MLREE1.PROG(I)                                                 
           AI(I)=MLREE2.PROG(I)                                                 
    9      CONTINUE                                                             
      ENDIF                                                                     
      J=NPT+1                                                                   
      I=1                                                                       
      XX(I)=RLTOCX(AR(I),AI(I))                                                 
      L11=L1-1                                                                  
      DO 10 II=2,L11                                                            
      I=I+1                                                                     
      J=J-1                                                                     
      XX(I)=RLTOCX(AR(I),AI(I))                                                 
      XX(J)=RLTOCX(AR(I),-AI(I))                                                
  10  CONTINUE                                                                  
      XX(I+1)=RLTOCX(AR(I+1),AI(I+1))                                           
C                                                                               
C     CALCUL DE LA FFT INVERSE                                                  
C                                                                               
      INV=.TRUE.                                                                
      CALL WEXP(INV,NPT,W)                                                      
      CALL FFTL(XX,YY,W,NPT)                                                    
C                                                                               
      IF(IIMPI.EQ.1) WRITE(IOIMP,*)' FFT INVERSE CALCULEE '                     
      SEGDES MLREE1,MLREE2                                                      
      SEGDES KEVOL1,KEVOL2                                          
      SEGDES MEVOLL                                                       
C                                                                               
C     CREATION ET CALCUL DES LISTES DE LA FFT                                   
C                                                                               
      JG=NPT                                                                    
      SEGINI MLREE1,MLREE2                                                      
      FMAX=DF*DBLE(NPT)                                                         
      DTEMP=1.D0/FMAX                                                           
C                                                                               
      DO 20 I=1,NPT                                                             
      TEMP=DBLE(I-1)*DTEMP                                                      
      MLREE1.PROG(I)=TEMP                                                       
      MLREE2.PROG(I)=DF*XX(I)                                                   
  20  CONTINUE                                                                  
      SEGDES MLREE1,MLREE2                                                      
C                                                                               
C                CREATION DE L'OBJET EVOLUTION REEL FFT INVERSE                 
C                                                                               
      N=1                                                                       
      SEGINI MEVOLL                                                             
      IPVO=MEVOLL                                                               
      IEVTEX=TITREE                                                             
      ITYEVO='REEL    '                                                         
C                                                                               
      SEGINI KEVOLL                                                             
      KEVTEX=TITREE                                                             
      TYPX='LISTREEL'                                                           
      TYPY='LISTREEL'                                                           
      IEVOLL(1)=KEVOLL                                                          
      IPROGX=MLREE1                                                             
      NOMEVX='TEMPS    SEC'                                                     
      IPROGY=MLREE2                                                             
      NOMEVY='TF INVERSE  '                                                     
      NUMEVX=ICOU1                                                              
      NUMEVY='REEL'                                                             
      SEGDES KEVOLL,MEVOLL                                                      
C                                                                               
      SEGSUP COMPL                                                              
C                                                                               
      CALL ECROBJ('EVOLUTIO',IPVO)                                              
  666 CONTINUE                                                                  
      RETURN                                                                    
      END