*$ CREATE USRMED.FOR
*COPY USRMED
*                                                                      *
*=== usrmed ===========================================================*
*                                                                      *
      SUBROUTINE USRMED ( IJ, EKSCO, PLA, WEE, MREG, NEWREG, XX, YY, ZZ,
     &                    TXX, TYY, TZZ )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 1991-2005      by    Alfredo Ferrari & Paola Sala  *
*     All Rights Reserved.                                             *
*                                                                      *
*                                                                      *
*     USeR MEDium dependent directives:                                *
*                                                                      *
*     Created on  10  may  1996    by    Alfredo Ferrari & Paola Sala  *
*                                                   Infn - Milan       *
*                                                                      *
*     Last change on   29-may-96   by    Alfredo Ferrari               *
*                                                                      *
*     Input variables:                                                 *
*             ij = particle id                                         *
*          Eksco = particle kinetic energy (GeV)                       *
*            Pla = particle momentum (GeV/c)                           *
*            Wee = particle weight                                     *
*           Mreg = (original) region number                            *
*         Newreg = (final)    region number                            *
*       Xx,Yy,Zz = particle position                                   *
*    Txx,Tyy,Tzz = particle direction                                  *
*                                                                      *
*     The user is supposed to change only WEE if MREG = NEWREG and     *
*     WEE, NEWREG, TXX, TYY, TZZ if MREG .NE. NEWREG                   *
*                                                                      *
*----------------------------------------------------------------------*
*
*------------------------------------------------------------------------*
*-------score all particles before and after beam dump CuCone Core--------*      
*      if(ij.eq.10.or.ij.eq.11.or.ij.eq.1.or.ij.eq.13.or.ij.eq.14)then
*before the dump
*        if((mreg.eq.11).and.(newreg.eq.13))then
*           write(94,2000,err=999)ij,Eksco
*         endif
*after the dump         
*         if((mreg.eq.8).and.(newreg.eq.9))then
*            write(95,2000,err=999)ij,Eksco  
*         endif
*         
*      endif
*     
*-------score all particles before and after beam dump Block Core--------*      
      if(ij.eq.10.or.ij.eq.11.or.ij.eq.1.or.ij.eq.13.or.ij.eq.14)then
*before the core
        if((mreg.eq.13).and.(newreg.eq.11))then
            write(94,2000,err=999)ij,Eksco
         endif
*after the core         
         if((mreg.eq.11).and.(newreg.eq.10))then
            write(95,2000,err=999)ij,Eksco  
         endif
*after the dump         
         if((mreg.eq.3).and.(newreg.eq.2))then
            write(96,2000,err=999)ij,Eksco  
         endif
         
      endif
*------------------------------------------------------------------------* 
*      if((mreg.eq.8).and.(newreg.eq.9))then
*         if(ij.eq.10.or.ij.eq.11.or.ij.eq.1.or.ij.eq.13.or.ij.eq.14)then
*            
*            write(95,2000,err=999)ij,pla
*            
*         endif
*      endif
*------------------------------------------------------------------------*      
      
 999  continue
 2000 format(i3,(1x,e14.7))
 
       RETURN
*=== End of subroutine Usrmed =========================================*
      END

