*-- 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 *