IAP GITLAB

Skip to content
Snippets Groups Projects
getmass.f 3.24 KiB
Newer Older
c $Id: getmass.f,v 1.9 1999/01/18 09:57:02 ernst Exp $
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      real*8 function getmass(ssqrt,type)
c
c     Revision : 1.0
c
cinput  ssqrt  :  maximum energy available
cinput  type   :  class of resonance defined in getrange
coutput getmass:  mass of the resonance
c
C  DETERMINES MASS OF A non-strange baryon RESONANCE.
c
c     function calls: massdist ranf
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      implicit none
      real*8 ssqrt,mdice,mm,mmax
      integer type
      real*8 ranf
      include 'comnorm.f'
      include 'comres.f'

c...  only n*,d,d* included in n_splint

      mmax=min(mresmax,ssqrt)

c get probability mdice
      call n_splint(x_norm,y_norm,y2a,n,mmax,mdice,type)
      if(mdice.eq.0)write(6,*)'getmass:mdice=',mdice
c for this probability choose mass mm
      call n_splint(y_norm,x_norm,y2b,n,mdice*ranf(0),mm,type)

      if(mm.lt.mresmin) then
         write(6,*)'(W) getmass-error - m, mmin',mm,mresmin
           mm=mresmin
      else if(mm.gt.mresmax) then
         write(6,*)'(W) getmass-error - m, ,max',mm,mresmax
           mm=mresmax
      endif

      getmass=mm

      return
      end

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      subroutine norm_init
c
coutput : via common-block comnorm
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      implicit none
      include 'comres.f'
      include 'comnorm.f'
      real*8 massdist
      real*8 x(n),y(n),y21(n),y22(n)
      integer i,j
c    linear weighting restored
c    in comnorm.f n is set to 400 again
      dx = (mresmax-mresmin)/dble(n-1) ! (n-1)**2 for quad. weight
      do 1 i=0,3
         y_norm(i,1) = 0.0
         y(1) = 0.0
         x_norm(i,1) = mresmin
         x(1) = mresmin
         do 2 j=2,n
            x_norm(i,j) = mresmin+dble(j-1)*dx ! (j-1)**2 for quad. weight
            x(j) = x_norm(i,j)
            y(j) = y(j-1) + (x(j)-x(j-1)) ! valid for both weights
     &                      *(massdist(x(j-1),i)+massdist(x(j),i)
     &                  + 4.0*massdist(0.5*(x(j)+x(j-1)),i))/6.0
            y_norm(i,j) = y(j)
2        continue
         call spline(x,y,n,massdist(mresmin,i),
     &                    massdist(mresmax,i),y21)
         call spline(y,x,n,1.0/massdist(mresmin,i),
     &                    1.0/massdist(mresmax,i),y22)
         do 3 j=1,n
            y2a(i,j) = y21(j)
            y2b(i,j) = y22(j)
3        continue
1     continue
      return
      end

c Numerical recipies:
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c  (modified)
      SUBROUTINE n_splint(xa,ya,y2a,n,x,y,m)
      implicit none
      INTEGER n,m
      real*8 x,y,xa(0:3,n),y2a(0:3,n),ya(0:3,n)
      INTEGER k,khi,klo
      real*8 a,b,h
      klo=1
      khi=n
1     if (khi-klo.gt.1) then
        k=(khi+klo)/2
        if(xa(m,k).gt.x)then
          khi=k
        else
          klo=k
        endif
      goto 1
      endif
      h=xa(m,khi)-xa(m,klo)
      if (h.eq.0.)pause 'bad xa input in splint'
      a=(xa(m,khi)-x)/h
      b=(x-xa(m,klo))/h
      y=a*ya(m,klo)+b*ya(m,khi)+((a**3-a)*y2a(m,klo)+
     *   (b**3-b)*y2a(m,khi))*(h**2)/6.
      return
      END
C  (C) Copr. 1986-92 Numerical Recipes Software.