*$ CREATE STUPRF.FOR
*COPY STUPRF
*
*=== stuprf ===========================================================*
*
      SUBROUTINE STUPRF ( IJ, MREG, XX, YY, ZZ, NPSECN, NPPRMR )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     SeT User PRoperties for Fluka particles:                         *
*                                                                      *
*     Created on  09 october 1997  by    Alfredo Ferrari & Paola Sala  *
*                                                   Infn - Milan       *
*                                                                      *
*     Last change on  14-aug-99    by    Alfredo Ferrari               *
*                                                                      *
*                                                                      *
*----------------------------------------------------------------------*
*
      INCLUDE '(EVTFLG)'
      INCLUDE '(FLKSTK)'
      INCLUDE '(TRACKR)'
*
      LOUSE   (NPFLKA)  = LLOUSE
      DO 100 ISPR = 1, MKBMX1
         SPAREK (ISPR,NPFLKA) = SPAUSR (ISPR)
  100 CONTINUE
      DO 200 ISPR = 1, MKBMX2
         ISPARK (ISPR,NPFLKA) = ISPUSR (ISPR)
  200 CONTINUE
*  +-------------------------------------------------------------------*
*  |  Inelastic interaction:
      IF ( LINEVT .AND. NPSECN .GT. NPPRMR ) THEN
*  |  Save inside Ispark(1) the parent id:
         ISPARK (1,NPFLKA) = IJ
*  |  Save inside Sparek the production position:         
         totr = sqrt(Xflk(NPFLKA)*Xflk(NPFLKA)+
     &        + Yflk(NPFLKA)*Yflk(NPFLKA)+Zflk(NPFLKA)*Zflk(NPFLKA))

         SPAREK (1,NPFLKA) = Pmoflk(NPFLKA)*Xflk(NPFLKA)/totr
         SPAREK (2,NPFLKA) = Pmoflk(NPFLKA)*Yflk(NPFLKA)/totr
         SPAREK (3,NPFLKA) = Pmoflk(NPFLKA)*Zflk(NPFLKA)/totr
         SPAREK (4,NPFLKA) = Pmoflk (NPFLKA)
*  |
*  +-------------------------------------------------------------------*
*  |  Decay:
      ELSE IF ( LDECAY .AND. NPSECN .GT. NPPRMR ) THEN
*  |  Save inside Ispark(2) the parent id:
         ISPARK (2,NPFLKA) = IJ
*  |  Save inside Sparek the production position:
         totr = sqrt(Xflk(NPFLKA)*Xflk(NPFLKA)+
     &        + Yflk(NPFLKA)*Yflk(NPFLKA)+Zflk(NPFLKA)*Zflk(NPFLKA))

         SPAREK (5,NPFLKA) = Pmoflk(NPFLKA)*Xflk(NPFLKA)/totr
         SPAREK (6,NPFLKA) = Pmoflk(NPFLKA)*Yflk(NPFLKA)/totr
         SPAREK (7,NPFLKA) = Pmoflk(NPFLKA)*Zflk(NPFLKA)/totr
         SPAREK (8,NPFLKA) = Pmoflk (NPFLKA)
      END IF
*  |
*  +-------------------------------------------------------------------*
*  Increment the track number and put it into the last flag:
      IF ( NPSECN .GT. NPPRMR ) THEN
         IF ( NTRCKS .EQ. 2000000000 ) NTRCKS = -2000000000
         NTRCKS = NTRCKS + 1
         ISPARK (MKBMX2,NPFLKA) = NTRCKS
      END IF
      RETURN
*=== End of subroutine Stuprf =========================================*
      END