c xlpf ( Apply Butterworth high pass filter) modified from
ccc
C XAPIIR -- SUBROUTINE:   IIR FILTER DESIGN AND IMPLEMENTATION                  
C                                                                               
C  AUTHOR:  Dave Harris  LAST MODIFIED:  September 12, 1990 
C                                                                               
C  ARGUMENTS:                                                                   
C  ----------                                                                   
C                                                                               
C    DATAS           REAL ARRAY CONTAINING SEQUENCE TO BE FILTERED               
C                     ORIGINAL DATA DESTROYED, REPLACED BY FILTERED DATA        
C                                                                               
C    NSAMPS         NUMBER OF SAMPLES IN DATAS                                   
C                                                                               
C                                                                               
C    FH             HIGH FREQUENCY CUTOFF OF FILTER (HERTZ)                      
C                                                                               
C                                                                               
C    TS             SAMPLING INTERVAL (SECONDS)                                 
C                                                                               
C                                                                               
      SUBROUTINE xlpf( DATAS, NSAMPS, FH , TS )                   
C                                                                               
C                                                                               
        implicit none
        real DATAS, FH, TS
        integer  NSAMPS
        DIMENSION DATAS(*)                                               
c
        INTEGER  PASSES, IORD, NSECTS                                  
        REAL   SN(30), SD(30), DCVALUE, WARP, FHW
        LOGICAL ZP                                                      
        COMPLEX P(10), Z(10)                                            
        CHARACTER*3 STYPE(10)                                           
c
        PASSES = 2
        IORD = 2
C                                                                               
C  Filter designed                                                              
C
        CALL BUROOTS( P, STYPE, DCVALUE, NSECTS, IORD )  
        FHW = WARP( FH*TS/2., 2. )                                    
        CALL LP( P, Z, STYPE, DCVALUE, NSECTS, SN, SD )            
        CALL CUTOFFS( SN, SD, NSECTS, FHW )   
        CALL BILIN2( SN, SD, NSECTS ) 
C                                                                               
C  Filter data                                                                  
C                                                                               
        IF (   PASSES .EQ. 1 ) THEN                                     
          ZP = .FALSE.                                                  
        ELSE                                                            
          ZP = .TRUE.                                                   
        END IF                                                          
        CALL APPLY( DATAS, NSAMPS, ZP, SN, SD, NSECTS )                  
C                                                                               
      RETURN                                                            
      END