      PROGRAM BTWLPF1T                                                          
C                                                                               
C                                                                               
      REAL*4        FSPEC(100),F1,F2,LOWA,LOWP,FREQ(100),AMP(100)               
      REAL*4        PHASE(100)                                                  
      INTEGER*4     MTIT(8),STIT(3)                                             
      INTEGER*4     ILOWA,ILOWP,I,J                                             
      INTEGER*4     ORD(9),XNAM(4),YNAM1(4),YNAM2(4)                            
      CHARACTER*36  LSTTIT(9),DISP                                              
C                                                                               
      DATA MTIT  /'BUTT','ERWO','RTH ','FILT','ER -','PROT',                    
     1'OTYP','E\  '/                                                            
      DATA STIT  /'    ','ORDE','R\  '/                                         
      DATA ORD   /'1ST ','2ND ','3RD ','4TH ','5TH ','6TH ','7TH '              
     1,'8TH ','9TH '/                                                           
      DATA XNAM  /'FREQ','UENC','Y (H','Z)\ '/                                  
      DATA YNAM1 /'MAGN','ITUD','E (d','B)\ '/                                  
      DATA YNAM2 /'PHAS','E (D','EGS)','\   '/                                  
C                                                                               
      DATA LSTTIT  /'BUTTERWORTH PROTOTYPE (LP) 1ST ORDER',                     
     +'BUTTERWORTH PROTOTYPE (LP) 2ND ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 3RD ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 4TH ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 5TH ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 6TH ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 7TH ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 8TH ORDER',                                   
     +'BUTTERWORTH PROTOTYPE (LP) 9TH ORDER'/                                   
C                                                                               
$INCLUDE SPLANE10.CMN(NLIST)                                                    
$INCLUDE ZPLANE10.CMN(NLIST)                                                    
C                                                                               
C                                                                               
C     INITIALISE                                                                
C     **********                                                                
C                                                                               
      CALL UERSET('BTWLPF1T','W','E','N')                                       
      CALL UERLU(7)                                                             
C                                                                               
C                                                                               
C     TEST(1):CALL BTWLPF WITH ORDER < 1                                        
C     **********************************                                        
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,1000)                                                             
C                                                                               
      CALL BTWLPF(0,FSPEC)                                                      
      CALL UERREP('TESTFILT',1,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(2):CALL BTWLPF WITH ARRAY NOT LONG ENOUGH                            
C     **********************************************                            
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,2000)                                                             
C                                                                               
      FSPEC(PSL)=7                                                              
      CALL BTWLPF(1,FSPEC)                                                      
      CALL UERREP('TESTFILT',2,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(3):CALL BTWLPF WITH MAX USED LENGTH < 0                              
C     ********************************************                              
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,3000)                                                             
C                                                                               
C     Correct previous error.                                                   
      FSPEC(PSL)=100                                                            
      FSPEC(PSU)=-1      ;ERROR                                                 
C                                                                               
      CALL BTWLPF(2,FSPEC)                                                      
      CALL UERREP('TESTFILT',3,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(4):CALL BTWLPF WITH CORRECT PARAMETERS                               
C     *******************************************                               
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,4000)                                                             
C                                                                               
C     Set up correct header values.                                             
      FSPEC(PSL)=100                                                            
      FSPEC(PSU)=2                                                              
C                                                                               
C     Set up values of N(=number of points)                                     
C                      F1=Low freq for plotter                                  
C                      F2=High freq for plotter                                 
C                                                                               
      N=20                                                                      
      F1=0.0                                                                    
      F2=1.0                                                                    
C                                                                               
      DO 4400 I=1,9                                                             
          WRITE(7,100)                                                          
C                                                                               
          CALL BTWLPF(I,FSPEC)                                                  
          CALL UERREP('TESTFILT',4,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
C         Output to LSTFLT                                                      
          DISP=LSTTIT(I)                                                        
          CALL LSTFLT(7,FSPEC,DISP)                                             
          CALL UERREP('TESTFILT',4,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
          WRITE(7,100)                                                          
C                                                                               
C         Output with APRFLT                                                    
          CALL APRFLT(FSPEC,AMP,PHASE,N,F1,F2)                                  
          CALL UERREP('TESTFILT',4,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
C         Set up LOWA & LOWP to large numbers.                                  
          LOWA=10000000.0                                                       
          LOWP=10000000.0                                                       
C                                                                               
C         Output mag/phase response - at same time find lowest                  
C                                    values of arrays AMP & PHASE               
C                                                                               
          WRITE(7,700)                                                          
          DO 5000 J=1,N                                                         
C                                                                               
              FREQ(J)=F1+(FLOAT(J-1)*(F2-F1)/FLOAT(N-1))                        
              WRITE(7,777)J,FREQ(J),AMP(J),PHASE(J)                             
C                                                                               
C             Find lowest values.                                               
              IF (AMP(J).LT.LOWA) THEN                                          
                  LOWA=AMP(J)                                                   
              ENDIF                                                             
              IF (PHASE(J).LT.LOWP) THEN                                        
                  LOWP=PHASE(J)                                                 
              ENDIF                                                             
C                                                                               
5000      CONTINUE                                                              
C                                                                               
C         Set up low values to nearest 10,20...etc                              
          ILOWA=INT(LOWA/10.0)-1                                                
          LOWA=10.0*FLOAT(ILOWA)                                                
          ILOWP=INT(LOWP/90.0)-1                                                
          LOWP=90.0*FLOAT(ILOWP)                                                
C                                                                               
C         Set up subtitle for PLOTTER                                           
          STIT(1)=ORD(I)                                                        
C                                                                               
C         Call ploting routines.                                                
C              1. With amplitude/frequency response.                            
C                                                                               
          PAUSE 'MAG RESPONSE'                                                  
          CALL PLOTIN                                                           
          CALL SETORG(4.0,4.0,21.0,14.0,0)                                      
          CALL TITLE(MTIT,STIT,'11.02.82')                                      
          CALL XAXIS(XNAM,F1,F2,0.1,1)                                          
          CALL YAXIS(YNAM1,LOWA,10.0,10.0,1)                                    
          CALL CONNCT(FREQ,AMP,N,7,0)                                           
C                                                                               
C              2. Output phase/frequency response.                              
C                                                                               
          PAUSE 'PHASE RESPONSE'                                                
          CALL PLOTIN                                                           
          CALL SETORG(4.0,4.0,21.0,14.0,0)                                      
          CALL TITLE(MTIT,STIT,'11.02.82')                                      
          CALL XAXIS(XNAM,F1,F2,0.1,1)                                          
          CALL YAXIS(YNAM2,LOWP,90.0,90.0,1)                                    
          CALL CONNCT(FREQ,PHASE,N,7,0)                                         
C                                                                               
C                                                                               
4400  CONTINUE                                                                  
C                                                                               
C                                                                               
C     FORMAT STATEMENTS                                                         
C     *****************                                                         
C                                                                               
100   FORMAT(X,//)                                                              
1000  FORMAT(X,'TEST(1):CALL BTWLPF WITH ORDER < 1',/)                          
2000  FORMAT(X,'TEST(2):CALL BTWLPF WITH ARRAY TOO SHORT',/)                    
3000  FORMAT(X,'TEST(3):CALL BTWLPF WITH MAX USED LENGTH < 0',/)                
4000  FORMAT(X,'TEST(4):CALL BTWLPF CORRECTLY',/)                               
777   FORMAT(3X,I2,4X,F14.7,4X,F14.7,4X,F14.7)                                  
700   FORMAT(4X,'NUMBER',6X,'FREQ(HZ)',7X,'MAGNITUDE(DB)',6X,                   
     1      'PHASE(DEG)',/)                                                     
C                                                                               
C                                                                               
      STOP                                                                      
      END                                                                       
