      PROGRAM MUGEN
*
*             Generate final muon momentum (px,py,pz) for a generic
*     underground detector
*
*
*     Contact:  Alfred Tang
*
*     Parameters:
*     ==========
*     nph            number of grid points along phi
*     ncz            number of grid points along cos(theta)
*     iph            number of search grid points along phi
*     jcz            number of search grid points along cos(theta)
*
*     Specification:-
*     =============
*     This code uses MUSIC to compute transport from a generic mountain
*     surface to an ungerground lab.  esimmax is the maximum muon energy
*     simulated.  As an example, the detector is assumed to an unright
*     cylinder.  The default value of lemin is set to the minimum which is
*     lemin=log(rest mass of muon).  lemin should be changed to correspond
*     to the minimum energy of the surviving muons crossing the minimum
*     thickness of rock.
*
*     Program Notes:-
*     =============
*     border.dat     input file containing the border of the hill profile
*     labxyz.dat     input file containing the lattice points of the hill
*                    profile
*     pxyz.dat       output file containing final muon momentum (px,py,pz)
*
*     The matrix elements ha(nph,ncz,i) with i=1,2 stores slant
*     depth in cm.
*
*     base = the offset corresponding to the center of the detector
*            above sealevel in meters (The top of the detector is
*            350m above sealevel.)
*     h0 = height of the tank in cm
*     r0 = radius of the tank in cm
*     pheh = azymuthal angle of the major axis of the hall in degrees
*     rest = muon rest mass
*     lemin = log10(E_min)  log of low muon energy cutoff
*     lemax = log10(E_max)  log of high muon energy cutoff
*     option = 1,2
*              (1) muons sampled at the center of the detector
*              (2) muons sampled on a large hemisphere
*     rhsp = radius of the hemispherical vacuum in cm

      implicit real*8 (a-h,o-z)
      integer option,ns
      double precision lemin,lemax,le
      parameter (pi=3.1415926535897932384626433)
      parameter (rho=2.65)
      parameter (base=0.)
      parameter (h0=678.)
      parameter (r0=326.5)
      parameter (rest=0.105658369)
      parameter (lemax=6.00000000)
      parameter (lemin=-0.97469413)
      parameter (rhsp=1000.)
      parameter (ns=500)
      parameter (option=2)

      integer ncz,nph,i,j,m,n,iph,jcz,il,iu,jl,ju,ih,istart,found,i1,i2
      integer p,m0,t1,t2,t3
      parameter (nph=100)
      parameter (ncz=100)
      parameter (iph=40)
      parameter (jcz=40)
      double precision ha(nph,ncz,3),ctm(nph,2)
      integer nb(nph,2)
      DOUBLE PRECISION CTMIN, CTMAX, k2
      double precision xe(ns),we(ns),xa(ns),wa(ns),norm
      PARAMETER (CTMAX = 1.0)  
      real*4 rcz,rp,rf,re,rh

      nthrows=10000

      call initialize_music
      iranlux=1
      iranlux1=1
      call rluxgo(3,iranlux,0,0)
      call rmarin(iranlux1,0,0)

      x0=0.
      y0=0.
      z0=0.
      ttime0=0.
      kmu=0
      emu=0.
      rmu=0.
      xmu=0.
      ymu=0.
      zmu=0.
      themu=0.
      phimu=0.
      theta=0.
      the=0.
      phi=0.
      ph=0.
      ih=0
      icount=0
      rmin=1.e20
      t1=0
      t2=0
      t3=0
      flevel=0.
      ftest=0.
      emax=0.
      px=0.
      py=0.
      pz=0.
      p0=0.
      k2=0.
      esim=0.
      esimmax=0.
      emin=10.**lemin
      emax=10.**lemax
      cthmax=1.
      fmax=cosmic_flux(emin,cthmax)
      fmin=cosmic_flux(emax,cthmax)
      fend=10.**lemax*fmin
      fdeno=10.**lemin*fmax-fend

      open(unit=10,file='border.dat',
     *form='formatted',status='old')
      open(unit=11,file='labxyz.dat',
     *form='formatted',status='old')
      open(unit=12,file='pxyz.dat',
     *form='formatted')
      open(unit=13,file='mugen.dat',
     *form='formatted')
      read(11,*) omega1,omega2,omega3,omega4
      omega=omega1+omega2+omega3+omega4
      read(11,*) ctmin

      t1=time()

      do 19 i=1,nph
         nb(i,1)=0
         nb(i,2)=0
         ctm(i,1)=0.
         ctm(i,2)=0.
 19   continue

 20   read(10,*,end=21)phi,cz
      i=int(phi/2./pi*nph)+1
      j=int((cz-ctmin)/(1.-ctmin)*ncz)+1
      nb(i,1)=nb(i,1)+j
      nb(i,2)=nb(i,2)+1
      ctm(i,1)=ctm(i,1)+cz
      ctm(i,2)=ctm(i,2)+1.
      goto 20
 21   close(10)

      found=0
      ilast=1
      do 22 i=1,nph
         if(nb(i,2).ne.0) then
            nb(i,1)=nb(i,1)/nb(i,2)
            ctm(i,1)=ctm(i,1)/ctm(i,2)
            ilast=i
         endif
      if(found.ne.1.and.nb(i,2).ne.0) then
         istart=i
         found=1
      endif
 22   continue

      i1=istart
      do 23 i=1,nph
         if(nb(i,2).ne.0) i1=i
         if(i.le.istart) then
            i1=ilast
            i0=ilast-nph
            i2=istart
            nb(i,1)=(i-i0)/(i2-i0)*(nb(i2,1)-nb(i1,1))+nb(i1,1)
            ctm(i,1)=(i-i0)/(i2-i0)*(ctm(i2,1)-ctm(i1,1))+ctm(i1,1)
         else
         if(nb(i,2).eq.0) then
            j=i
 24         j=j+1
            if(nb(j,2).eq.0.and.j.lt.nph) goto 24
            if(i.eq.nph) i2=i+istart
            if(i.lt.nph) i2=j
            nb(i,1)=(i-i1)/(i2-i1)*(nb(i2,1)-nb(i1,1))+nb(i1,1)
            ctm(i,1)=(i-i1)/(i2-i1)*(ctm(i2,1)-ctm(i1,1))+ctm(i1,1)
         endif
         endif
 23   continue

      do 3 i=1,nph
         do 4 j=1,ncz
            ha(i,j,1)=0.
            ha(i,j,2)=0.
            ha(i,j,3)=0.
 4       continue
 3    continue

 12   read (11,*,end=13) x0,y0,z0
      z0=z0-base
      if(z0.lt.0.) z0=0.
      r=dsqrt(x0**2+y0**2+z0**2)
      cx=x0/r
      cy=y0/r
      cz=z0/r
      IF(cx.NE.0.) THEN
         phi=datan(cy/cx)
         IF(cx.LT.0.) phi=pi+phi
      END IF
      IF(cx.EQ.0.) THEN
         phi=pi/2.
         IF(cy.LT.0.) phi=pi*3./2.
      END IF
      IF(phi.GT.pi*2.) phi=-pi*2.+phi
      IF(phi.LT.0.) phi=phi+pi*2.
      i=int(phi/2./pi*nph)+1
      j=int((cz-ctmin)/(1.-ctmin)*ncz)+1
      ha(i,j,1)=ha(i,j,1)+r
      ha(i,j,2)=ha(i,j,2)+r
      ha(i,j,3)=ha(i,j,3)+1.
      go to 12
 13   close(11)

      do 1 i=1,nph
         do 2 j=1,ncz
            if(ha(i,j,3).ne.0.) then
               ha(i,j,1)=ha(i,j,1)/ha(i,j,3)
               ha(i,j,2)=ha(i,j,2)/ha(i,j,3)
               if(ha(i,j,1).lt.rmin) rmin=ha(i,j,1)
            endif
            if(ha(i,j,3).gt.1.) ih=ih+1
 2       continue
 1    continue
      print*,'number of overlapped lattice points: ',ih
      print*,'rmin (cm): ',rmin
      print*,'suggested low muon energy threshold (GeV): ',
     $ 500.*(exp(.35*rmin/100000.*2.65)-1.)

      print*,'Processing lattice sites ......'

      do 5 i=1,nph
         do 6 j=1,ncz
            if(j.ge.nb(i,1)) then
            test=0.
            tempmax=0.
            il=i-iph
            ju=j+jcz
            do 7 m0=1,2*iph+1
               m=m0-1+il
               p=m
               if(m.lt.1) p=nph+m
               if(m.gt.nph) p=m-nph
               do 8 n=nb(p,1),ju
                  if(n.le.ncz) then
                  ph1=i*2.*pi/nph
                  th1=j*.5*pi/ncz
                  ph2=p*2.*pi/nph
                  th2=n*.5*pi/ncz
                  if(ha(p,n,3).gt.test) test=ha(p,n,3)
                   temp=dsin(th1)*dcos(ph1)*dsin(th2)*dcos(ph2)
     $                  +dsin(th1)*dsin(ph1)*dsin(th2)*dsin(ph2)
     $                  +dcos(th1)*dcos(th2)
                   if(temp.ge.tempmax.and.ha(p,n,3).ne.0.) then
                      tempmax=temp
                      ha(i,j,1)=ha(p,n,2)
                   endif
                   endif
 8             continue
 7          continue
            if(test.eq.0.) then
               print*,"error: grid too small"
               if(m.eq.0) print*,i,j,m0,n0,m,n,p
               stop
            endif
            endif
 6       continue
 5    continue

      t2=time()
      print*,'Begin simulation ....................'

      DO N = 1,NTHROWS
 66      call ranlux(rp,1)
         phi=rp*2.*pi
         i=int(phi/2./pi*nph)+1
         call ranlux(rcz,1)
         cz = ctm(i,1) + rcz*(CTMAX-ctm(i,1))
         j=int((cz-ctmin)/(1.-ctmin)*ncz)+1
         theta=dacos(cz)
         call ranlux(re,1)
         le=lemin+re*(lemax-lemin)
         emu=10.**le
         fthis=emu*cosmic_flux(emu,cz)
         ftest=(fthis-fend)/fdeno
         if(ftest.lt.0..or.ftest.gt.1.) goto 66
         call ranlux(rf,1)
         if(rf.gt.ftest) goto 66

         r=ha(i,j,1)

         if(option.eq.2) r=r-rhsp

* Resume muon transport
         cz0=cz
         cx0=dsin(theta)*dcos(phi)
         cy0=dsin(theta)*dsin(phi)
         x=r*cx0
         y=r*cy0
         z=r*cz0
         cx=-cx0
         cy=-cy0
         cz=-cz0
         ttime=ttime0
         depth=r
         call muon_transport(x,y,z,cx,cy,cz,emu,depth,ttime)
         IF(cx.NE.0.) THEN
            phi=datan(cy/cx)
            IF(cx.LT.0.) phi=pi+phi
         END IF
         IF(cx.EQ.0.) THEN
            phi=pi/2.
            IF(cy.LT.0.) phi=pi*3./2.
         END IF
         IF(phi.GT.pi*2.) phi=-pi*2.+phi
         IF(phi.LT.0.) phi=phi+pi*2.
         the = theta * 180. / pi
         ph = phi * 180. / pi

         if(emu.gt.0.) then
            kmu=kmu+1
            k2=emu**2-rest**2
            if(k2.lt.0.) then
               print*,'(Warning: negative k2!) emu = ',emu
            else
               p0=dsqrt(k2)
               px=p0*cx
               py=p0*cy
               pz=p0*cz
               esim=emu
               if(esim.gt.esimmax) esimmax=esim
               write(12,"(3E18.7)") px,py,pz
            endif
         end if

         icount=icount+1
         IF (MOD(icount,nthrows/5).EQ.0)
     $        WRITE(6,*) 'PROCESSED ',icount,' THROWS.'

      ENDDO

      if(kmu.gt.0) then
         spmu=1.*kmu/nthrows
      end if

      t3=time()

      print*,'nph, ncz, iph, jcz: ',nph,ncz,iph,jcz
      print*,'number of overlapped lattice sites: ',ih
      print*,'zenth angle cut, ctmin-->deg:  ',ctmin,' -->',
     $ int(dacos(ctmin)*180./pi)
      print*,'omega:                         ',omega
      print*,'nthrows:                        ',nthrows
      print*,'option:                         ',option
      print*,'number of surving muons:        ',kmu
      print*,'survival probability:          ',spmu
      print*,'emaxsim (GeV):                 ',esimmax
      print*,'number of seconds used in processing the lattice: ',t2-t1
      print*,'number of seconds used in simulating muons:       ',t3-t2

      write(13,*)'nph, ncz, iph, jcz: ',nph,ncz,iph,jcz
      write(13,*)'number of overlapped lattice sites: ',ih
      write(13,*)'zenth angle cut, ctmin-->deg:  ',ctmin,' -->',
     $ int(dacos(ctmin)*180./pi)
      write(13,*)'omega:                         ',omega
      write(13,*)'nthrows:                        ',nthrows
      write(13,*)'option:                         ',option
      write(13,*)'number of surving muons:        ',kmu
      write(13,*)'survival probability:          ',spmu
      write(13,*)'emaxsim (GeV):                 ',esimmax
      write(13,*)'number of seconds used in processing the lattice: ',
     $ t2-t1
      write(13,*)'number of seconds used in simulating muons:       ',
     $ t3-t2

      close(12)
      close(13)
      stop
      END

      DOUBLE PRECISION FUNCTION COSMIC_FLUX(EMU,COSTH)
 
      IMPLICIT NONE
      REAL CS_A, CS_GAMMA, CS_RC
      integer model

      DOUBLE PRECISION CTMIN, CTMAX,de,emu0,emu1,em,low
      PARAMETER (CTMIN = 0.0)
      PARAMETER (CTMAX = 1.0)
      parameter (low = 1.)
 
      DOUBLE PRECISION EMU,COSTH,costa,PAR(2)
      DATA PAR /115., 850./

      costa=costh
      if(costa.ne.1.) then
      costa=dsqrt((costa**2+1.052122e-2-.068287*costa**.958633+
     $     .0407253*costa**.817285)/.9829595)
      endif
      if(costa.ge.1.) costa=1.

      cs_a=1.
      cs_gamma=2.7
      cs_rc=0.
      model=0
      emu0=emu
      emu1=emu

      if(emu0.le.low/costa) then
         emu0=(3.*emu0+7.*low/costa)/10.
         emu1=emu0
      endif

      if(emu0.le.100./costa) then
         cs_rc=1.e-4
         de=2.06e-3*(950./costa-90.)
         emu0=emu1+de
         cs_a=1.1*(9.*dsqrt(costh+.001)/103.)**(4.5/costa/emu0)
      endif
  
C     This function returns DI/Dcos*DE for muons at the Earth's surface.
 
      COSMIC_FLUX = 0.
      IF ((COSTH.LE.CTMIN).OR.(COSTH.GT.CTMAX)) RETURN
 
      IF (MODEL.EQ.0) THEN

         COSMIC_FLUX = CS_A * 0.14 * 
     $        (EMU1)**(-CS_GAMMA) *
     $        (1./(1.+1.1*EMU0*COSTA/PAR(1)) +
     $        0.054/(1.+1.1*EMU0*COSTA/PAR(2)) + CS_RC)
         
      ELSEIF (MODEL.EQ.1) THEN

         COSMIC_FLUX = CS_A * 372. / (EMU*COSTH + 80.) *
     $        (5.*EMU + 10./COSTH)**(-CS_GAMMA) *
     $        ((EMU + 15.)/(EMU + 15./COSTH))

      ENDIF

      RETURN
      END

