      PROGRAM CFFTC1                                                            
C                                                                               
C   MODULE        TEST CFFTC10                                                  
C   VERSION       1.0                                                           
C   LAST MODIFIED 22/10/81                                                      
C   AUTHOR        DAVE POWELL                                                   
C   ---------------------------------------------------------------             
C   PROGRAM TO TEST CFFTC10                                                     
C                                                                               
C   ---------------------------------------------------------------             
C                                                                               
C                                                                               
      REAL*4 PI,SRSIG(128),SISIG(128),SSR(64),SSI(64)                           
      INTEGER*4 I6,I7,I8,I9,K                                                   
      COMPLEX COMSIG(128)                                                       
      DATA PI/3.141592653589793/                                                
C                                                                               
C   (1) SET UP PROGRAM NAME AND ERROR THRESHOLDS                                
C   ********************************************                                
C                                                                               
      CALL UERSET('CFFTC1T','W','E','F')                                        
      CALL UERLU(7)                                                             
C                                                                               
C   (2) TEST(1):CALL SUBROUTINE WITH ONE SAMPLE                                 
C   *******************************************                                 
C                                                                               
      WRITE(7,2000)                                                             
      CALL CFFTC(1,COMSIG,2)                                                    
      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 CFFTC(4096,COMSIG,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 CFFTC(16,COMSIG,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 CFFTC(7,COMSIG,4)                                                    
      CALL UERREP('FFTTEST',4,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,5001)                                                             
C                                                                               
C                                                                               
C  (6) SET UP PARAMETERS                                                        
C  *********************                                                        
C                                                                               
      N=128                                                                     
C                                                                               
C                                                                               
C   (7) CALL SUBROUTINE WITH DIFFERENT OPTIONS                                  
C   ******************************************                                  
C                                                                               
      WRITE(7,7003)                                                             
      DO 7000 I7=1,8,2                                                          
          IOPT=I7                                                               
          CALL CSINGEN(N,SRSIG,SISIG,COMSIG)                                    
          CALL CFFTC(N,COMSIG,IOPT)                                             
          CALL UERREP('FFTTEST',5,.FALSE.)                                      
          CALL UERCLR                                                           
          WRITE(7,7001)I7                                                       
          WRITE(7,7002)(SRSIG(K),SISIG(K),COMSIG(K),K=1,N)                      
C     ENDDO                                                                     
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 CSQRGEN(COMSIG,SSR,SSI)                                          
          CALL CFFTC(N,COMSIG,IOPT)                                             
          CALL UERREP('FFTTEST',6,.FALSE.)                                      
          CALL UERCLR                                                           
          WRITE(7,9001)I9                                                       
          WRITE(7,9002)(SSR(K),SSI(K),COMSIG(K),K=1,N)                          
C     ENDDO                                                                     
9000  CONTINUE                                                                  
C                                                                               
C   (9) CALL FOURIER TRANSFORM PAIRS                                            
C   *********************************                                           
C                                                                               
C   (a) PAIR 1 :NO BIT SHUFFLE                                                  
C                                                                               
      CALL CSQRGEN(COMSIG,SSR,SSI)                                              
      CALL CFFTC(N,COMSIG,1)                                                    
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      CALL CFFTC(N,COMSIG,2)                                                    
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,100)                                                              
      WRITE(7,101)(SSR(K),SSI(K),COMSIG(K),K=1,N)                               
C                                                                               
C   (b)PAIR 2 :BIT SHUFFLE                                                      
C                                                                               
      CALL CSQRGEN(COMSIG,SSR,SSI)                                              
      CALL CFFTC(N,COMSIG,5)                                                    
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      CALL CFFTC(N,COMSIG,6)                                                    
      CALL UERREP('FFTTEST',7,.FALSE.)                                          
      CALL UERCLR                                                               
      WRITE(7,102)                                                              
      WRITE(7,103)(SSR(K),SSI(K),COMSIG(K),K=1,N)                               
C                                                                               
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 CFFTC WITH IOPT=9',/,X,30('*'),/)                  
3001  FORMAT(//)                                                                
3000  FORMAT(X,'TEST(2):CALL CFFTC WITH 4096 SAMPLES',                          
     +/,X,36('*'),/)                                                            
2001  FORMAT(//)                                                                
2000  FORMAT(X,'TEST(1):CALL CFFTC WITH ONE SAMPLE',/,                          
     +X,34('*'),/)                                                              
C                                                                               
C                                                                               
C   (10) END                                                                    
C   ********                                                                    
C                                                                               
      STOP                                                                      
      END                                                                       
