      SUBROUTINE BTWLPF(N,FSPEC)                                                
C                                                                               
C MODULE        BTWLPF                                                          
C VERSION       1.0                                                             
C PACKAGE       SIGPRO                                                          
C ROUTINE NO    10                                                              
C LAST MODIFIED 07/12/81                                                        
C AUTHOR        N C SEDGWICK                                                    
C                                                                               
C CALCULATES THE S-PLANE POLE POSITIONS OF AN N'TH                              
C ORDER BUTTERWORTH LOW PASS FILTER WITH UNITY                                  
C CUTOFF (-3DB) POINT.  WRITES THE S-PLANE SINGULARITIES                        
C TO FSPEC IN S-PLANE FORMAT                                                    
C                                                                               
C PARAMETERS                                                                    
C **********                                                                    
C                                                                               
C N       I*4  ORDER OF FILTER                                                  
C FSPEC   R*4A ARRAY TO RECEIVE FILTER SPEC IN S-PLANE FORMAT                   
C                                                                               
      INTEGER N                                                                 
C LENGTH OF FSPEC IS INDETERMIATE                                               
      REAL  FSPEC(9999)                                                         
C                                                                               
C GLOBAL VARIABLES                                                              
C ****************                                                              
C                                                                               
$INCLUDE SIGPRO10.CMN (NLIST)                                                   
$INCLUDE SPLANE10.CMN (NLIST)                                                   
C                                                                               
C LOCAL VARIABLES                                                               
C ***************                                                               
C                                                                               
C LFSPEC  I*4  LENGTH OF FSPEC TO BE USED                                       
C IS      I*4  LOOP COUNTER                                                     
C IP      I*4  POINTER TO CURRENT ENTRY IN FSPEC                                
C IER     I*4  ERROR NUMBER                                                     
C RTN     P    ROUTINE NUMBER WITHIN PACKAGE                                    
C PI      R*4  3.14159....                                                      
C                                                                               
      INTEGER LFSPEC,IS,IP,IER,RTN                                              
      REAL*4 PI                                                                 
      PARAMETER (RTN=40)                                                        
C                                                                               
C===================================================================            
C                                                                               
C CHECK PARAMETERS                                                              
C ****************                                                              
C                                                                               
      IF(N.LT.1) GOTO 9001                                                      
C LENGTH OF FSPEC                                                               
      IF( (N/2)*2.NE.N) THEN                                                    
      LFSPEC=PSH+PSE*(N+1)/2                                                    
      ELSE                                                                      
      LFSPEC=PSH+PSE*N/2                                                        
      ENDIF                                                                     
      IF(INT(FSPEC(PSL)).LT.LFSPEC) GOTO 9003                                   
      IF(INT(FSPEC(PSU)).LT.0) GOTO 9004                                        
C                                                                               
C                                                                               
C SET UP HEADER VALUES IN FSPEC                                                 
C *****************************                                                 
C                                                                               
C SET FSPEC MAX USED LENGTH                                                     
      IF(LFSPEC.GT.INT(FSPEC(PSU))) FSPEC(PSU)=LFSPEC                           
C                                                                               
C SET FSPEC ARRAY TYPE TO S-PLANE                                               
      FSPEC(PSX)=PSV                                                            
C                                                                               
C SET NUMBER OF SINGULARITYS                                                    
      IF( (N/2)*2.EQ.N) THEN                                                    
      FSPEC(PSN)=N/2                                                            
      ELSE                                                                      
      FSPEC(PSN)=(N+1)/2                                                        
      ENDIF                                                                     
      PI=4.0*ATAN(1.0)                                                          
C                                                                               
C LOOP OVER COMPLEX CONGUGATE POLE PAIRS                                        
C **************************************                                        
C                                                                               
      IF( (N/2)*2.LE.0) GOTO 1010                                               
      DO 1000 IS=1,N/2                                                          
C SET POINTER TO CURRENT SINGULARITY                                            
      IP=PSH+1+PSE*(IS-1)                                                       
C CALCULATE VALUES FOR CURRENT SINGULARITY                                      
      FSPEC(IP+PSM)=IS                                                          
      FSPEC(IP+PST)=PST2P                                                       
      FSPEC(IP+PSG)=1.0                                                         
      FSPEC(IP+PSJ)=0.0                                                         
      FSPEC(IP+PSR)=COS(PI*(0.5+FLOAT(2*IS-1)/FLOAT(2*N)))                      
      FSPEC(IP+PSI)=SIN(PI*(0.5+FLOAT(2*IS-1)/FLOAT(2*N)))                      
1000  CONTINUE                                                                  
1010  CONTINUE                                                                  
C                                                                               
C SET UP LAST SINGLE REAL POLE IF N IS ODD                                      
C ****************************************                                      
C                                                                               
      IF( (N/2)*2.NE.N) THEN                                                    
      IS=(N+1)/2                                                                
      IP=PSH+1+PSE*(IS-1)                                                       
      FSPEC(IP+PSM)=IS                                                          
      FSPEC(IP+PST)=PSTRP                                                       
      FSPEC(IP+PSG)=1.0                                                         
      FSPEC(IP+PSJ)=0.0                                                         
C***PE3220 FORTRAN-VIID COMPILER BUG ON LEADING - SIGN                          
C     FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSR)=0.0-1.0                                                     
C FSPEC(IP+PSI) IS ZERO BUT SHOULD NEVER BE USED                                
      FSPEC(IP+PSI)=0.0                                                         
      ENDIF                                                                     
C                                                                               
C RETURN                                                                        
C ******                                                                        
C                                                                               
      RETURN                                                                    
C                                                                               
C===================================================================            
C                                                                               
C ERRORS                                                                        
C ******                                                                        
C                                                                               
C ORDER OF FILTER (N) IS OUT OF RANGE                                           
9001  CONTINUE                                                                  
      IER=11                                                                    
      GOTO 9999                                                                 
C                                                                               
      GOTO 9999                                                                 
C                                                                               
C FSPEC IS NOT LONG ENOUGH OR IS NOT SET UP                                     
9003  CONTINUE                                                                  
      IER=12                                                                    
      GOTO 9999                                                                 
C                                                                               
C FSPEC IS NOT SET UP                                                           
9004  CONTINUE                                                                  
      IER=13                                                                    
      GOTO 9999                                                                 
C                                                                               
C GENERAL ERROR EXIT                                                            
C ------------------                                                            
C                                                                               
9999  CONTINUE                                                                  
      CALL UERERR('FILTER',RTN,IER,0,'E')                                       
      CALL UERREP('FILTER',RTN,.TRUE.)                                          
      RETURN                                                                    
      END                                                                       
