SUBROUTINE FPEAKF
*-- Author :    Girish D. Patel   07/06/93
      SUBROUTINE FPEAKF(IDH,area,xmax,thresh)
                                                                        
      COMMON/FHLUN/ LUNH, LUNS, LMES, IL4L5                             
                                                                        
      PARAMETER (NBIN=100)                                              
      DIMENSION BAK(100),BAKE(100)                                      
      CHARACTER*80 CTITL                                                
                                                                        
      AREA = 0.0                                                        
      L = LMES                                                          
      CALL HGIVE(IDH,CTITL,NX,XMI,XMA,NY,YMI,YMA,NWT,LOC)                                              
      IF(NX.GT.NBIN) THEN                                               
        WRITE(L,*) ' FPEAKF Histogram ',IDH,' has more than 100 bins '  
        GOTO 100                                                        
      ENDIF                                                             
      BINW = (XMA-XMI)/FLOAT(NX)                                        
      CALL HUNPAK(IDH,BAK,'HIST',1)                                                                    
      CALL HUNPKE(IDH,BAKE,'HIST',1)                                                                   
      YMAX = -1.                                                        
      IMAX = -1                                                         
      DO 10 I = 2 , NX                                                  
        IF(BAK(I).GT.YMAX) THEN                                         
          YMAX = BAK(I)                                                 
          IMAX = I                                                      
        ENDIF                                                           
   10 CONTINUE                                                          
                                                                        
      IF(IMAX.EQ.-1) THEN                                               
        GOTO 100                                                        
      ENDIF                                                             
                                                                        
      ISTART = IMAX - 4                                                 
      IF(ISTART.LT.1) ISTART = 1                                        
      IEND   = IMAX + 5                                                 
      IF(IEND .GT.NX) IEND   = NX                                       
                                                                        
      DO 20 I = 1 , NX                                                  
        IF(I.LT.ISTART .or. I.GT.IEND .or. BAK(I).LT.0.) THEN           
          BAKE(I) = 0.0                                                 
          BAK(I) = 0.0                                                  
         ELSE                                                           
           AREA = AREA + BAK(I)*BINW                                    
        ENDIF                                                           
   20 CONTINUE                                                          
                                                                        
      xmax = XMI + FLOAT(IMAX)*BINW                                     
      thresh= xmax - 8.0*BINW                                           
                                                                        
      CALL HPAK(IDH,BAK)                                                                               
      CALL HPAKE(IDH,BAKE)                                                                             
                                                                        
  100 RETURN                                                            
      END                                                               
*