      REAL FUNCTION nt952()
*     
      LOGICAL         CHAIN
      CHARACTER*128   CFILE
*     
      COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT
      COMMON /PAWCHC/ CFILE
*     
      COMMON/PAWIDN/IDNEVT,OBS(13),
     +     X0FIT,PHIFIT,Z,DELTAX,DELTAT,AMPLITUD,AMPLROW,PAD     
*
      CHARACTER*20 CHTEXT
      PARAMETER (NZBIN=15,NABIN=20,NARBIN=5)
*     
      IF(ICHEVT.EQ.1 )THEN
* pad response function 10010+x
         DO I=1,NZBIN
            WRITE(CHTEXT,'(A6,I3)') 'PRF, Z',I
            CALL HBPROF(10010+I,CHTEXT,35,-6.,6.,-0.01,2.0,' ')
         ENDDO
* amplitude error 10110+x
         DO I=1,NABIN
            WRITE(CHTEXT,'(A9,I3)') 'AMPLITUDE',I
            AMAX = 100.
            IF( i.lt.5 )AMAX=50
            CALL HBOOK1(10110+I,CHTEXT,100,-AMAX,AMAX,0.)
         ENDDO
* pad response function as fkt of amplitude
         DO I=1,NARBIN
            WRITE(CHTEXT,'(A6,I3,A11)') 'PRF, A',I,'           '
            CALL HBPROF(10210+I,CHTEXT,50,-5.,5.,-0.01,3.0,' ')
         ENDDO
         
         CALL HBOOK2(10110,'ampl',40,0.,200.,50,0.,250.,0.)

         CALL HBPROF(10001,'PRF, Z=7, pad=48  ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10002,'PRF, Z=7, pad=49 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10003,'PRF, Z=7, pad=50 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10004,'PRF, Z=7, pad=51 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10005,'PRF, Z=7, pad=15 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10006,'PRF, Z=7, pad=16 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10007,'PRF, Z=7, pad=17 ',31,-5.,5.,-0.01,2.0,' ')
         CALL HBPROF(10008,'PRF, Z=7, pad=18 ',31,-5.,5.,-0.01,2.0,' ')
      ENDIF

      IPAD = NINT(PAD)
      
      IF( ABS(PHIFIT).GT.0.15 ) RETURN
*      IF( ABS(PHIFIT).GT.0.08727 ) RETURN

      DO I=1,NZBIN
         IF( Z.LT.REAL(I)/REAL(NZBIN)*150. )THEN
            IZ = I
            GOTO 100
         ENDIF
      ENDDO
 100  CONTINUE
 
      CALL HFILL(10010+IZ,DELTAX,AMPLITUD,1.)


      IF( Z.GT.60. .AND. Z.LT.80. )THEN
         IF( IPAD.EQ.48 ) CALL HFILL(10001,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.49 ) CALL HFILL(10002,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.50 ) CALL HFILL(10003,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.51 ) CALL HFILL(10004,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.15 ) CALL HFILL(10005,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.16 ) CALL HFILL(10006,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.17 ) CALL HFILL(10007,DELTAX,AMPLITUD,1.)
         IF( IPAD.EQ.18 ) CALL HFILL(10008,DELTAX,AMPLITUD,1.)
      ENDIF

      AMPL = AMPLITUD*AMPLROW
      AMPLPRF = qrat(deltax,fwhm(z))*AMPLROW
      IA = NABIN
      DO I=1,NABIN
         IF( AMPLPRF.LT.REAL(I)/REAL(NABIN)*200. )THEN
            IA = I
            GOTO 200
         ENDIF
      ENDDO
 200  CONTINUE
 
      DELTAA = AMPL-AMPLPRF
      CALL HF1(10110+IA,DELTAA,1.)
      
      call HF2(10110,ampl,amplprf,1.)
      
      IF( Z.GT.60. .AND. Z.LT.80. )THEN
      IAR = NARBIN
      DO I=1,NARBIN
         IF( AMPLROW.LT.REAL(I)/REAL(NARBIN)*200. )THEN
            IAR = I
            GOTO 300
         ENDIF
      ENDDO
 300  CONTINUE
         CALL HFILL(10210+IAR,DELTAX,AMPLITUD,1.)
      ENDIF
      
      END
      function qrat(xpos,width)

      x0=0.0
      ampeak=1.0
      gam=width
      del=12.
      a=-0.8
      b=0

      x = xpos-x0

*     The value of the prf function at position 'x' is then given by:
      qrat =  ampeak*qratio(a,b,gam,del,x) 
      return
      end

      function qratio(a,b,gam,del,c)
*     Normalized pad response function

*     Ratio of two symmetric 4th order polynomials
*     The function can approximate a variety of line shapes
*     from a Gaussian to a Lorentzian

      y=gam/2.
      x=del/2.
      a4=a/x**4
      p=-(1.+a)
      a2=p/x**2
      b4=b/y**4
      q=1.+2.*a2*y**2+(2.*a4-b4)*y**4
      b2=q/y**2
      qn=1.+a2*c**2+a4*c**4
      qd=1.+b2*c**2+b4*c**4
      qratio=qn/qd
      return
      end
      function fwhm(z)
      fwhm = sqrt(8.805+0.03674*z)
      end
      
