      PROGRAM CFFTF1T                                                           
C                                                                               
C   MODULE        TEST CFFTF10                                                  
C   VERSION       1.0                                                           
C   LAST MODIFIED 12/11/81                                                      
C   AUTHOR        DAVE POWELL                                                   
C   ---------------------------------------------------------------             
C   PROGRAM TO TEST CFFTF10                                                     
C                                                                               
C   ---------------------------------------------------------------             
C                                                                               
C                                                                               
      REAL*4 PI,RSIG(128),ISIG(128),SRSIG(128),SISIG(128),SR(64)                
      REAL*4 SI(64),SSR(64),SSI(64)                                             
      INTEGER*4 I7,I8,I9,K                                                      
      DATA PI/3.14159265/                                                       
C                                                                               
C   (1) SET UP PROGRAM NAME AND ERROR THRESHOLDS                                
C   ********************************************                                
C                                                                               
      CALL UERSET('CFFTF1T','W','E','F')                                        
      CALL UERLU(7)                                                             
      WRITE(7,1000)                                                             
C                                                                               
C   (2) TEST(1):CALL SUBROUTINE WITH ONE SAMPLE                                 
C   *******************************************                                 
C                                                                               
      WRITE(7,2000)                                                             
      CALL CFFTF(1,RSIG,ISIG,8)                                                 
      CALL UERREP('FFTTEST',1,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,2001)                                                             
C                                                                               
C   (3) TEST(2):CALL SUBROUTINE WITH 4096 SAMPLES                               
C   *********************************************                               
C                                                                               
      WRITE(7,3000)                                                             
      CALL CFFTF(4096,RSIG,ISIG,2)                                              
      CALL UERREP('FFTTEST',2,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,3001)                                                             
C                                                                               
C   (4) TEST(3):CALL SUBROUTINE WITH IOPT OUT OF RANGE                          
C   **************************************************                          
C                                                                               
      WRITE(7,4000)                                                             
      CALL CFFTF(16,RSIG,ISIG,9)                                                
      CALL UERREP('FFTTEST',3,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,4001)                                                             
C                                                                               
C   (5) TEST(4):CALL SUBROUTINE WITH N NOT POWER OF 2                           
C   *************************************************                           
C                                                                               
      WRITE(7,5000)                                                             
      CALL CFFTF(7,RSIG,ISIG,4)                                                 
      CALL UERREP('FFTTEST',4,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,5001)                                                             
C                                                                               
C                                                                               
C  (6) SET UP PARAMETERS                                                        
C  *********************                                                        
C                                                                               
      N=128                                                                     
      DELTAX=8.0*PI/FLOAT(N)                                                    
C                                                                               
C                                                                               
C   (7) CALL SUBROUTINE WITH DIFFERENT OPTIONS                                  
C   ******************************************                                  
C                                                                               
      WRITE(7,7003)                                                             
      DO 7000 I7=1,8,2                                                          
          IOPT=I7                                                               
          DO 6000 I6=1,N                                                        
              RSIG(I6)=COS(DELTAX*(I6-1))                                       
              ISIG(I6)=SIN(DELTAX*(I6-1))                                       
              SRSIG(I6)=RSIG(I6)                                                
              SISIG(I6)=ISIG(I6)                                                
6000      CONTINUE                                                              
          CALL CFFTF(N,RSIG,ISIG,IOPT)                                          
          CALL UERREP('FFTTEST',5,.FALSE.)                                      
          CALL UERCLR                                                           
          WRITE(7,7001)I7                                                       
          WRITE(7,7002)(SRSIG(K),SISIG(K),RSIG(K),ISIG(K),K=1,N)                
7000  CONTINUE                                                                  
C                                                                               
C                                                                               
C   (8) CALL SUBROUTINE WITH SQUARE WAVE-WITH DIFFERENT IOPT                    
C   ********************************************************                    
C                                                                               
      WRITE(7,9003)                                                             
      N=64                                                                      
      DO 9000 I9=1,8,2                                                          
          IOPT=I9                                                               
          CALL FSQRGEN(SR,SI,SSR,SSI)                                           
          CALL CFFTF(N,SR,SI,IOPT)                                              
          CALL UERREP('FFTTEST',6,.FALSE.)                                      
          CALL UERCLR                                                           
          WRITE(7,9001)I9                                                       
          WRITE(7,9002)(SSR(K),SSI(K),SR(K),SI(K),K=1,N)                        
9000  CONTINUE                                                                  
C                                                                               
C   (9) CALL FOURIER TRANSFORM PAIRS                                            
C   *********************************                                           
C                                                                               
C   (a) PAIR 1 :NO BIT SHUFFLE                                                  
C                                                                               
      CALL FSQRGEN(SR,SI,SSR,SSI)                                               
      CALL CFFTF(N,SR,SI,1)                                                     
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      CALL CFFTF(N,SR,SI,2)                                                     
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,100)                                                              
      WRITE(7,101)(SSR(K),SSI(K),SR(K),SI(K),K=1,N)                             
      CALL FSQRGEN(SR,SI,SSR,SSI)                                               
      CALL CFFTF(N,SR,SI,5)                                                     
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      CALL CFFTF(N,SR,SI,6)                                                     
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,102)                                                              
      WRITE(7,103)(SSR(K),SSI(K),SR(K),SI(K),K=1,N)                             
C                                                                               
C       FORMAT STATEMENTS                                                       
C       *****************                                                       
C                                                                               
103   FORMAT(4(2X,E14.7,2X))                                                    
102   FORMAT(/,X,'(b) CALL FORWARD FT (IOPT=5) THEN INVERSE'                    
     +' FT (IOPT=6)-BIT SHUFFLE ON BOTH',/)                                     
101   FORMAT(4(2X,E14.7,2X))                                                    
100   FORMAT(//,X,'TEST(7):TESTING OF FT PAIRS',/,X,30('*'),//,X,'(a)'          
     +' CALL FORWARD FT(IOPT=1) THEN INVERSE FT(IOPT=2)-NO BIT SHUFFLE')        
9002  FORMAT(4(2X,E14.7,2X))                                                    
9001  FORMAT(//,X,'IOPT=',I2,//,7X,'REAL I/P',10X,'IMAG I/P',10X,               
     +'REAL O/P',10X,'IMAG O/P',/,7X,8('*'),10X,8('*'),10X,                     
     +,8('*'),10X,8('*'),/)                                                     
9003  FORMAT(//,X,'TEST(6):CALL SUBROUTINE WITH IOPT=1,3,5,7',                  
     +'(SQUARE WAVE)',/,X,54('*'),//)                                           
7002  FORMAT(4(2X,E14.7,2X))                                                    
7001  FORMAT(/,X,'IOPT=',I2,//,7X,'REAL I/P',10X,'IMAG I/P',                    
     +10X,'REAL O/P',10X,'IMAG O/P',/,7X,8('*'),10X,8('*'),10X,                 
     +8('*'),10X,8('*'),/)                                                      
7003  FORMAT(X,'TEST(5):CALL SUBROUTINE WITH IOPT=1,3,5,7'                      
     +,'(SINE WAVE)',/,X,53('*'),/)                                             
5001  FORMAT(//)                                                                
5000  FORMAT(X,'TEST(4):CALL SUBROUTINE WITH N NOT POWER OF 2'                  
     +,/,X,45('*'),/)                                                           
4001  FORMAT(//)                                                                
4000  FORMAT(X,'TEST(3):CALL CFFTF WITH IOPT=9',/,X,30('*'),                    
     +/)                                                                        
3001  FORMAT(//)                                                                
3000  FORMAT(X,'TEST(2):CALL CFFTF WITH 4096 SAMPLES',                          
     +/,X,36('*'),/)                                                            
2001  FORMAT(//)                                                                
2000  FORMAT(X,'TEST(1):CALL CFFTF WITH ONE SAMPLE',/,                          
     +X,34('*'),/)                                                              
1000  FORMAT(20X,'TEST OF CFFTF10',/,20X,15('*'),//)                            
C                                                                               
C                                                                               
C   (10) END                                                                    
C   ********                                                                    
C                                                                               
      STOP                                                                      
      END                                                                       
