      PROGRAM TRFFTC                                                            
C                                                                               
C   MODULE        TRFFTC                                                        
C   VERSION       1.0                                                           
C   LAST MODIFIED 8/12/81                                                       
C   AUTHOR        DAVE POWELL                                                   
C                                                                               
$INCLUDE UERC10.CMN(NLIST)                                                      
$INCLUDE UER10.CMN(NLIST)                                                       
      REAL*4 SIG(64),Y,ST(64),CONV,MAG(33),PHASE(33)                            
      INTEGER*4 CD,IOPT,N                                                       
      DATA PI/3.141592653589793/                                                
      GOTO 1                                                                    
C                                                                               
C                                                                               
C   (1) SET UP PROGRAM NAME AND ERROR THRESHOLDS                                
C   ********************************************                                
C                                                                               
      CALL UERSET('SIGPROG','W','E','F')                                        
      CALL UERLU(6)                                                             
C                                                                               
1     CONTINUE                                                                  
C                                                                               
C   (2) TEST(1):CALL SUBROUTINE WITH ONE SAMPLE                                 
C   *******************************************                                 
C                                                                               
      WRITE(6,200)                                                              
      CALL RFFTC(1,SIG,2)                                                       
      IF(UERENO.NE.0) CALL UERREP('SIGREP',1,.FALSE.)                           
      CALL UERCLR                                                               
      WRITE(6,201)                                                              
C                                                                               
C                                                                               
C   (3) TEST(2):CALL SUBROUTINE WITH 4096 SAMPLES                               
C   *********************************************                               
C                                                                               
      GOTO 2                                                                    
      WRITE(6,300)                                                              
      CALL RFFTC(4096,SIG,2)                                                    
      IF(UERENO.NE.0) CALL UERREP('SIGREP',2,.FALSE.)                           
      CALL UERCLR                                                               
      WRITE(6,201)                                                              
2     CONTINUE                                                                  
C                                                                               
C                                                                               
C   (4) TEST(3):CALL SUBROUTINE WITH IPOT OUT OF RANGE                          
C   **************************************************                          
C                                                                               
      WRITE(6,400)                                                              
      CALL RFFTC(16,SIG,9)                                                      
      IF(UERENO.NE.0) CALL UERREP('SIGREP',4,.FALSE.)                           
      CALL UERCLR                                                               
      WRITE(6,201)                                                              
C                                                                               
C                                                                               
C   (5) TEST(4):CALL SUBROUTINE WITH N NOT POWER OF 2                           
C   *************************************************                           
C                                                                               
      WRITE(6,500)                                                              
      CALL RFFTC(7,SIG,4)                                                       
      IF(UERENO.NE.0) CALL UERREP('SIGREP',4,.FALSE.)                           
      CALL UERCLR                                                               
      WRITE(6,201)                                                              
C                                                                               
C                                                                               
C   (6) SET UP PARAMETERS                                                       
C   *********************                                                       
C                                                                               
      N=64                                                                      
      Y=8.0*PI/FLOAT(N)                                                         
      CONV=360.0/(2.0*PI)                                                       
C                                                                               
C                                                                               
C   (7) TEST(5):CALL SUBROUTINE WITH DIFFERENT IOPT                             
C   ***********************************************                             
C                                                                               
      WRITE(6,703)                                                              
      DO 7000 I7=1,8,2                                                          
          IOPT=I7                                                               
          DO 7001 J7=1,N                                                        
              SIG(J7)=COS(Y*(J7-1))                                             
              ST(J7)=SIG(J7)                                                    
7001      CONTINUE                                                              
          CALL RFFTC(N,SIG,IOPT)                                                
          IF(UERENO.NE.0) CALL UERREP('SIGREP',5,.FALSE.)                       
          CALL UERCLR                                                           
          CALL MAGPHAS(N/2,SIG,MAG,PHASE)                                       
          WRITE(6,701)I7                                                        
          WRITE(6,702)                                                          
          DO 7003 L7=1,N/2+1                                                    
              WRITE(6,700)L7,MAG(L7),PHASE(L7)                                  
7003      CONTINUE                                                              
7000  CONTINUE                                                                  
C                                                                               
C                                                                               
C   (8) TEST(6):CALL RFFTC WITH DIFFERENT IOPT (SQUARE WAVE)                    
C   ********************************************************                    
C                                                                               
      WRITE(6,803)                                                              
      DO 8000 I8=1,8,2                                                          
          IOPT=I8                                                               
          DO 8001 J8=1,16                                                       
              SIG(J8)=1.0                                                       
              SIG(J8+16)=-1.0                                                   
              SIG(J8+32)=1.0                                                    
              SIG(J8+48)=-1.0                                                   
8001      CONTINUE                                                              
          CALL RFFTC(64,SIG,IOPT)                                               
          IF(UERENO.NE.0) CALL UERREP('SIGREP',6,.FALSE.)                       
          CALL UERCLR                                                           
          CALL MAGPHAS(N/2,SIG,MAG,PHASE)                                       
          WRITE(6,701)I8                                                        
          WRITE(6,702)                                                          
          DO 8003 L8=1,N/2+1                                                    
              WRITE(6,700)L8,MAG(L8),PHASE(L8)                                  
8003      CONTINUE                                                              
8000  CONTINUE                                                                  
C                                                                               
C                                                                               
C   (9) TEST(7):CALL RFFTC WITH IOPT=0,2,4,6(IMPULSE)                           
C   *************************************************                           
C                                                                               
      WRITE(6,900)                                                              
      DO 9000 I9=0,6.2                                                          
          IOPT=I9                                                               
          DO 9001 J9=1,64                                                       
              SIG(J9)=0.0                                                       
9001      CONTINUE                                                              
          SIG(5)=1.0                                                            
          CALL RFFTC(64,SIG,IOPT)                                               
          IF(UERENO.NE.0) CALL UERREP('SIGREP',7,.FALSE.)                       
          CALL UERCLR                                                           
          CALL MAGPHAS(N/2,SIG,MAG,PHASE)                                       
          WRITE(6,701)I9                                                        
          WRITE(6,702)                                                          
          DO 9003 L9=1,N/2+1                                                    
              WRITE(6,700)L9,MAG(L9),PHASE(L9)                                  
9003      CONTINUE                                                              
9000  CONTINUE                                                                  
C                                                                               
C                                                                               
C   (10) FORMAT STATEMENTS                                                      
C   **********************                                                      
C                                                                               
200   FORMAT(X,'TEST(1):CALL RFFTC WITH ONE SAMPLE',/,X,34('*'),/)              
201   FORMAT(//)                                                                
300   FORMAT(X,'TEST(2):CALL RFFTC WITH 4096 SAMPLES',/,X,36('*'),/)            
400   FORMAT(X,'TEST(3):CALL RFFTC WITH IOPT=9',/,X,30('*'),/)                  
500   FORMAT(X,'TEST(4):CALL RFFTC WITH N NOT POWER OF 2',/,X,40('*'),/)        
703   FORMAT(X,'TEST(5):CALL RFFTC WITH IOPT=1,3,5,7(SINE WAVE)'                
     +,53('*'),/)                                                               
701   FORMAT(10X,'TEST OF RFFTC WITH IOPT=',I1,/,10X,25('*'),/)                 
702   FORMAT(6X,'MAGNITUDE',5X,'PHASE',/)                                       
700   FORMAT(2X,I1,4X,E14.7,4X,E14.7)                                           
803   FORMAT(X,'TEST(6):CALL RFFTC WITH IOPT=1,3,5,7(SQUARE WAVE)',             
     +/,X,50('*'),/)                                                            
900   FORMAT(X,'TEST(7):CALL RFFTC WITH IOPT=0,2,4,6(IMPULSE)',                 
     +/,X,40('*'),/)                                                            
C                                                                               
C                                                                               
C   (11) END                                                                    
C   ********                                                                    
C                                                                               
      STOP                                                                      
      END                                                                       
