      SUBROUTINE LPF(SSPECI,SSPECO,FREQ)                                        
C                                                                               
C  MODULE         LPF                                                           
C  VERSION        1.0                                                           
C  ROUTINE NO     50                                                            
C  LAST MODIFIED  22/12/81                                                      
C  AUTHOR         DAVE POWELL                                                   
C                                                                               
C  THIS SUBROUTINE TAKES A PROTOTYPE LOW PASS FILTER WITH A                     
C  BREAKPOINT AT ANGULAR FREQUENCY 1 RAD/SEC AND CONVERTS TO                    
C  A LOW PASS FILTER WITH BREAKPOINT AT f=FREQ.                                 
C                                                                               
C  PARAMETERS                                                                   
C  **********                                                                   
C                                                                               
C  SSPECI   R*4A  INPUT S-PLANE ARRAY                                           
C  SSPECO   R*4A  OUTPUT S-PLANE ARRAY                                          
C  FREQ     R*4   BREAK FREQUENCY                                               
C                                                                               
C  THE LENGTH OF SSPECI AND SSPECO ARE INDETERMINANT                            
      REAL*4 SSPECI(9999),SSPECO(9999),FREQ                                     
C                                                                               
C  GLOBAL VARIABLES                                                             
C  ****************                                                             
C                                                                               
$INCLUDE SIGPRO10.CMN(NLIST)                                                    
$INCLUDE SPLANE10.CMN(NLIST)                                                    
C                                                                               
C                                                                               
C  LOCAL VARIABLES                                                              
C  ***************                                                              
C                                                                               
      REAL*4 PI,W                                                               
      INTEGER*4 RTN,NS,IP,IS                                                    
      PARAMETER (RTN=50)                                                        
C                                                                               
C  (1) CHECK PARAMETERS                                                         
C  ********************                                                         
C                                                                               
      IF (FREQ.LT.0.0) GOTO 9003                                                
      IF (INT(SSPECI(PSX)).NE.PSV) GOTO 9001                                    
C                                                                               
C  (2) INITIALISE                                                               
C  **************                                                               
C                                                                               
      SSPECI(PSX)=PSV                                                           
      SSPECO(PSX)=PSV                                                           
      NS=INT(SSPECI(PSN))                                                       
      IF (NS.LT.0) GOTO 9004                                                    
      PI=4.0*ATAN(1.0)                                                          
      W=2.0*PI*FREQ                                                             
C                                                                               
C  (3) CHECK OUTPUT IS LONG ENOUGH AND SET MAX USED LENGTH                      
C  *******************************************************                      
C                                                                               
      SSPECO(PSN)=NS                                                            
      IF (PSH+PSE*NS.GT.INT(SSPECO(PSL))) GOTO 9005                             
      IF (PSH+PSE*NS.GT.INT(SSPECO(PSU))) THEN                                  
          SSPECO(PSU)=PSH+PSE*NS                                                
      ENDIF                                                                     
C                                                                               
C  (4) CALCULATION FOR EACH SINGULARITY - OUTPUT IN SSPECO                      
C  *******************************************************                      
C                                                                               
      IF (NS.LE.0) GOTO 4100                                                    
C     Sweep over singularities.                                                 
      DO 4000 IS=1,NS                                                           
          IPS=PSH+1+PSE*(IS-1)                                                  
          TYPE=INT(SSPECI(IPS+PST))                                             
C                                                                               
C         Real Zero.                                                            
          IF (TYPE.EQ.PSTRZ) THEN                                               
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PSTRZ                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)/W                                 
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)/W                                 
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Real Pole.                                                            
          ELSEIF (TYPE.EQ.PSTRP) THEN                                           
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PSTRP                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)*W                                 
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)*W                                 
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Complex Zero.                                                         
          ELSEIF (TYPE.EQ.PSTCZ) THEN                                           
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PSTCZ                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)/W                                 
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)/W                                 
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Complex Pole.                                                         
          ELSEIF (TYPE.EQ.PSTCP) THEN                                           
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PSTCP                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)*W                                 
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)*W                                 
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Complex conjugate zero pair.                                          
          ELSEIF (TYPE.EQ.PST2Z) THEN                                           
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PST2Z                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)/(W**2)                            
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)/(W**2)                            
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Complex conjugate pole pair.                                          
          ELSEIF (TYPE.EQ.PST2P) THEN                                           
              SSPECO(IPS+PSM)=IS                                                
              SSPECO(IPS+PST)=PST2P                                             
              SSPECO(IPS+PSG)=SSPECI(IPS+PSG)*(W**2)                            
              SSPECO(IPS+PSJ)=SSPECI(IPS+PSJ)*(W**2)                            
              SSPECO(IPS+PSR)=SSPECI(IPS+PSR)*W                                 
              SSPECO(IPS+PSI)=SSPECI(IPS+PSI)*W                                 
C                                                                               
C         Type not recognised.                                                  
          ELSE                                                                  
              GOTO 9006                                                         
          ENDIF                                                                 
4000  CONTINUE                                                                  
4100  CONTINUE                                                                  
C                                                                               
      RETURN                                                                    
C                                                                               
C  (4) ERRORS                                                                   
C  **********                                                                   
C                                                                               
C     Input array is not of correct type.                                       
9001  CONTINUE                                                                  
      IER=14                                                                    
      GOTO 9999                                                                 
C                                                                               
C     Frequency less than zero.                                                 
9003  CONTINUE                                                                  
      IER=15                                                                    
      GOTO 9999                                                                 
C                                                                               
C     NS is less than zero.                                                     
9004  CONTINUE                                                                  
      IER=16                                                                    
      GOTO 9999                                                                 
C                                                                               
C     Output array is not long enough.                                          
9005  CONTINUE                                                                  
      IER=17                                                                    
      GOTO 9999                                                                 
C                                                                               
C     Singularity type not recognised.                                          
9006  CONTINUE                                                                  
      IER=18                                                                    
C                                                                               
9999  CONTINUE                                                                  
      CALL UERERR('FILTER',RTN,IER,0,'E')                                       
      CALL UERREP('FILTER',RTN,.TRUE.)                                          
      RETURN                                                                    
      END                                                                       
