      PROGRAM BPF10T                                                            
C                                                                               
C     THIS PROGRAM TESTS THE ROUTINE LPF10                                      
C     WRITING IS TO LOGICAL UNIT 7                                              
C     ASSUMES THAT LOGICAL UNIT 4 IS ASIGNED TO THE PLOTTER                     
C                                                                               
$INCLUDE SPLANE10.CMN(NLIST)                                                    
$INCLUDE ZPLANE10.CMN(NLIST)                                                    
C                                                                               
C                                                                               
      REAL*4       FSPEC(100),FSPECO(100),AMP(100),PHASE(100)                   
      REAL*4       F1,F2,FREQ(100),LOWA,LOWP,FLOW(4),FHI(4),HIP                 
      INTEGER*4    N,IHIP,ILOWA,ILOWP                                           
      INTEGER*4    MTIT(10),STIT(6),BP(4),XTIT(4),YTIT1(4),YTIT2(3)             
      INTEGER*4    BPH(4)                                                       
      CHARACTER*52 LTIT(4)                                                      
C                                                                               
      DATA  FSPEC  /100*0.0/                                                    
      DATA FSPECO  /100*0.0/                                                    
      DATA AMP     /100*0.0/                                                    
      DATA PHASE   /100*0.0/                                                    
      DATA FLOW    /5.0,5.0,10.0,10.0/                                          
      DATA FHI     /15.0,10.0,15.0,11.0/                                        
C                                                                               
      DATA MTIT  /'BUTT','ERWO','RTH ','BAND','PASS',' FIL',                    
     1              'TER\','    ','    ','    '/                                
      DATA STIT  /'BREA','KPOI','NTS=','    ','    ','Z\  '/                    
      DATA BP    /'5HZ ','5HZ ','10HZ','10HZ'/                                  
      DATA BPH  /'-15H','-10H','-15H','-11H'/                                   
      DATA XTIT  /'FREQ','UENC','Y (H','Z)\ '/                                  
      DATA YTIT1 /'MAGN','ITUD','E (d','B)\ '/                                  
      DATA YTIT2 /'PHAS','E (D','EG)\'/                                         
      DATA LTIT/'BUTTERWORTH FILTER 9TH ORDER-BPF-;BREAKPOINT=5-15HZ ',         
     +'BUTTERWORTH FILTER 9TH ORDER-BPF-;BREAKPOINT=5-10HZ ',                   
     +'BUTTERWORTH FILTER 9TH ORDER-BPF-;BREAKPOINT=10-15HZ',                   
     +'BUTTERWORTH FILTER 9TH ORDER-BPF-;BREAKPOINT=10-11HZ'/                   
C                                                                               
C     INITIALISE                                                                
C     **********                                                                
C                                                                               
      CALL UERSET('BPF10T','W','E','N')                                         
      CALL UERLU(7)                                                             
C                                                                               
C                                                                               
C     TEST(1):CALL BPF10 WITH I/P ARRAY NOT OF CORRECT TYPE                     
C     *****************************************************                     
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,1000)                                                             
C                                                                               
C     Write header                                                              
      FSPEC(PSL)=100                                                            
      FSPEC(PSU)=0                                                              
      FSPEC(PSX)=1000  ;UNKNOWN TYPE                                            
      FSPEC(PSN)=1                                                              
      FSPECO(PSL)=100                                                           
C                                                                               
      CALL BPF(FSPEC,FSPECO,2.0,4.0)                                            
      CALL UERREP('TESTFILT',1,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(2):CALL BPF WITH FREQ < 0                                            
C     ******************************                                            
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,2000)                                                             
C                                                                               
C     Correct previous error.                                                   
      FSPEC(PSX)=PSV                                                            
C                                                                               
      CALL BPF(FSPEC,FSPECO,-1.0,0.1)                                           
      CALL UERREP('TESTFILT',2,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(3):CALL BPF WITH NO. OF SINGS < 1                                    
C     **************************************                                    
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,3000)                                                             
C                                                                               
      FSPEC(PSN)=-1                                                             
C                                                                               
      CALL BPF(FSPEC,FSPECO,2.0,4.0)                                            
      CALL UERREP('TESTFILT',3,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(4):CALL BPF WITH O/P ARRAY NOT LONG ENOUGH                           
C     ***********************************************                           
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,4000)                                                             
C                                                                               
C     Correct previous error                                                    
      FSPEC(PSN)=1                                                              
C     Artificially declare length = 5                                           
      FSPECO(PSL)=5                                                             
C                                                                               
      CALL BPF(FSPEC,FSPECO,2.0,4.0)                                            
      CALL UERREP('TESTFILT',4,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     TEST(5):CALL BPF WITH INDIVIDUAL SINGULARITIES                            
C     **********************************************                            
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,5000)                                                             
C                                                                               
C     Correctly write header                                                    
      FSPEC(PSL)=100                                                            
      FSPEC(PSU)=0                                                              
      FSPEC(PSX)=PSV                                                            
      FSPEC(PSN)=1                                                              
      FSPECO(PSL)=100                                                           
C                                                                               
C                                                                               
C     Real Zero                                                                 
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PSTRZ                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=0.0        ;POS=-1.0+j0.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'R ZERO-GAIN=3+j4;POS=-1+j0 BP=10-20HZ')             
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C     Real pole                                                                 
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PSTRP                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=0.0        ;POS=-1.0+j0.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'R POLE-GAIN=3+j4;POS=-1+j0 BP=10-20HZ')             
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      WRITE(7,100)                                                              
C                                                                               
C     Complex zero                                                              
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PSTCZ                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=1.0        ;POS=-1.0+j1.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'COM ZERO-GAIN=3+j4;POS=-1+j1 BP=10-20HZ')           
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      WRITE(7,100)                                                              
C                                                                               
C     Complex pole                                                              
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PSTCP                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=1.0        ;POS=-1.0+j1.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'COM POLE-GAIN=3+j4;POS=-1+j1 BP=10-20HZ')           
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      WRITE(7,100)                                                              
C                                                                               
C     Complex conjugate zero pair                                               
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PST2Z                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=1.0        ;POS=-1.0+j1.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'C Z PAIR-GAIN=3+j4;POS=-1+j1 BP=10-20HZ')           
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      WRITE(7,100)                                                              
C                                                                               
C     Complex conjugate pole pair                                               
      IP=PSH+1                                                                  
      FSPEC(IP+PSM)=1                                                           
      FSPEC(IP+PST)=PSTRP                                                       
      FSPEC(IP+PSG)=3.0                                                         
      FSPEC(IP+PSJ)=4.0        ;GAIN=3.0+j4.0                                   
      FSPEC(IP+PSR)=-1.0                                                        
      FSPEC(IP+PSI)=1.0        ;POS=-1.0+j1.0                                   
C                                                                               
      CALL BPF(FSPEC,FSPECO,10.0,20.0)                                          
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      CALL LSTFLT(7,FSPECO,'C P PAIR-GAIN=3+j4;POS=-1+j1 BP=10-20HZ')           
      CALL UERREP('TESTFILT',5,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C                                                                               
C     TEST(6):CALL BPF TO DESIGN FILTER WITH HF BREAKPOINTS AT 3,5,10,15 HZ     
C     *******************************************************************       
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,6000)                                                             
C     Call prototype filter - o/p in FSPEC - Design all others from this        
      CALL BTWLPF(9,FSPEC)                                                      
      CALL UERREP('TESTFILT',6,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
      N=50                                                                      
      F1=1.0                                                                    
      F2=19.0                                                                   
      DO 6666 I=1,4                                                             
C                                                                               
C         For each loop a new HP filter will be obtained                        
C         Output will use LSTFLT & APRFLT & PLOTTER                             
C                                                                               
          CALL BPF(FSPEC,FSPECO,FLOW(I),FHI(I))                                 
          CALL UERREP('TESTFILT',6,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
          CALL LSTFLT(7,FSPECO,LTIT(I))                                         
          CALL UERREP('TESTFILT',6,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
          WRITE(7,100)                                                          
C                                                                               
          CALL APRFLT(FSPECO,AMP,PHASE,N,F1,F2)                                 
          CALL UERREP('TESTFILT',6,.FALSE.)                                     
          CALL UERCLR                                                           
C                                                                               
          LOWA=AMP(1)                                                           
          LOWP=PHASE(1)                                                         
          HIP=PHASE(1)                                                          
C         Output the contents of 'AMP' & 'PHASE'                                
C         Also using the DO LOOP to find smallest values of them.               
          WRITE(7,7600)                                                         
          DO 6777 J=1,N                                                         
              FREQ(J)=F1+(F2-F1)*FLOAT(J-1)/FLOAT(N-1)                          
              WRITE(7,7610)J,FREQ(J),AMP(J),PHASE(J)                            
              IF (AMP(J).LT.LOWA) THEN                                          
                  LOWA=AMP(J)                                                   
              ENDIF                                                             
              IF (PHASE(J).LT.LOWP) THEN                                        
                  LOWP=PHASE(J)                                                 
              ENDIF                                                             
              IF (PHASE(J).GT.HIP) THEN                                         
                  HIP=PHASE(J)                                                  
              ENDIF                                                             
6777      CONTINUE                                                              
C                                                                               
          ILOWA=INT(LOWA/10.0)-1                                                
          LOWA=10.0*FLOAT(ILOWA)                                                
          ILOWP=INT(LOWP/90.0)-1                                                
          LOWP=90.0*FLOAT(ILOWP)                                                
          IHIP=INT(HIP/90.0)+1                                                  
          HIP=90.0*FLOAT(IHIP)                                                  
C                                                                               
C         Set up subtitle for plotter routines                                  
          STIT(4)=BP(I)                                                         
          STIT(5)=BPH(I)                                                        
C                                                                               
C         Call plotter routines                                                 
C            1. With amplitude/frequency response.                              
          PAUSE 'MAG RESPONSE'                                                  
          CALL PLOTIN                                                           
          CALL SETORG(4.0,4.0,21.0,14.0,0)                                      
          CALL TITLE(MTIT,STIT,'12.02.82')                                      
          CALL XAXIS(XTIT,F1,F2,2.0,1)                                          
          CALL YAXIS(YTIT1,LOWA,10.0,20.0,1)                                    
          CALL CONNCT(FREQ,AMP,N,7,0)                                           
C                                                                               
C            2. With phase/frequency response.                                  
          PAUSE 'PHASE RESPONSE'                                                
          CALL PLOTIN                                                           
          CALL SETORG(4.0,4.0,21.0,14.0,0)                                      
          CALL TITLE(MTIT,STIT,'12.02.82')                                      
          CALL XAXIS(XTIT,F1,F2,2.0,1)                                          
          CALL YAXIS(YTIT2,LOWP,HIP,90.0,1)                                     
          CALL CONNCT(FREQ,PHASE,N,7,0)                                         
C                                                                               
6666  CONTINUE                                                                  
C                                                                               
C                                                                               
C     TEST(7):CALL BPF WITH JUST ONE FREQ NEGATIVE                              
C     ********************************************                              
C                                                                               
      WRITE(7,100)                                                              
      WRITE(7,7000)                                                             
C                                                                               
C     Leave array as it was - just change parameters                            
      CALL BPF(FSPEC,FSPEC0,-1.0,2.0)                                           
      CALL UERREP('TESTFILT',7,.FALSE.)                                         
      CALL UERCLR                                                               
C                                                                               
C                                                                               
C                                                                               
C                                                                               
C     FORMAT STATEMENTS                                                         
C     *****************                                                         
C                                                                               
100   FORMAT(X,//)                                                              
1000  FORMAT(X,'TEST(1):CALL BPF WITH I/P ARRAY NOT S',/)                       
2000  FORMAT(X,'TEST(2):CALL BPF WITH FREQ < 0',/)                              
3000  FORMAT(X,'TEST(3):CALL BPF WITH NO OF SINGS < 1',/)                       
4000  FORMAT(X,'TEST(4):CALL BPF WITH O/P ARRAY NOT LONG ENOUGH',/)             
5000  FORMAT(X,'TEST(5):CALL BPF WITH INDIVIDUAL SINGULARITIES',/)              
6000  FORMAT(X,'TEST(6):CALL BPF WITH VARIOUS BREAKPOINTS',/)                   
7000  FORMAT(X,'TEST(7):CALL BPF WITH ONE FREQ NEGATIVE',/)                     
7610  FORMAT(3X,I2,4X,F14.7,4X,F14.7,4X,F14.7)                                  
7600  FORMAT(4X,'NUMBER',6X,'FREQ(HZ)',7X,'MAGNITUDE(DB)',6X,                   
     1       'PHASE(DEG)',/)                                                    
C                                                                               
C                                                                               
      STOP                                                                      
      END                                                                       
