C   07/06/96 606071843  MEMBER NAME  DPEAK    (S4)          FORTG1
      SUBROUTINE DPEAK(NA,KA,XA,XZ,SIG)
      COMMON/BCS/IW(1)
      REAL RW(1)
      EQUIVALENCE (RW(1),IW(1))
      CALL BLOC(IND,'PEA*',NA,&1)
      GOTO 100
    1 CALL BCRE(IND,'PEA*',NA,10,&100,IER)
      FWHM=2.35482*SIG
      X1=AMIN1(XA,XZ)-FWHM*2.0
      X2=AMAX1(XA,XZ)+FWHM*2.0
      ST=AMAX1(0.1*FWHM,0.01*(X2-X1))
      NB=0.5+(X2-X1)/ST
      AW=0.5*(X1+X2-FLOAT(NB)*ST)
      NB=((NB+9)/10)*10
      IF(NB.GT.100) NB=100
      IF(NB.LT.20) NB=20
      CALL XBINS(X1,X2,NB,AW,ST)
C
   20 RW(IND+1)=AW
      RW(IND+2)=AW+FLOAT(NB)*ST
      RW(IND+3)=FWHM
      RW(IND+4)=SIG
      RW(IND+5)=AW
      RW(IND+6)=ST
      IW(IND+7)=NB
      IW(IND+8)=-1
C
      NW=(NB+2)*(KA+1)
      CALL BCHL(NW,&100)
      IW(IND+8)=KA
      CALL VZERO(IW(IND+11),NW)
      GOTO 100
C
      ENTRY UPEAK(NA,KA,X)
      IF(KA.LT.0) GOTO 100
      CALL BLOC(IND,'PEA*',NA,&100)
      IF(IW(IND+8).LT.KA) GOTO 100
      K=(X-RW(IND+5))/RW(IND+6)+1.0
      IF(K.GT.IW(IND+7)) K=IW(IND+7)+2
      IF(K.LE.0) K=IW(IND+7)+1
      INDK=IND+10+K+KA*(IW(IND+7)+2)
      RW(INDK)=RW(INDK)+1.0
  100 RETURN
      END
