*                                                                      *
*=== mgdraw ===========================================================*
*                                                                      *
      SUBROUTINE MGDRAW ( ICODE, MREG )

        INCLUDE '(DBLPRC)'
        INCLUDE '(DIMPAR)'
        INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 2003-2019:  CERN & INFN                            *
*     All Rights Reserved.                                             *
*                                                                      *
*                                                                      *
*     MaGnetic field trajectory DRAWing: actually this entry manages   *
*                                        all trajectory dumping for    *
*                                        drawing                       *
*                                                                      *
*     Created on   01 March 1990   by        Alfredo Ferrari           *
*                                              INFN - Milan            *
*                                                                      *
*----------------------------------------------------------------------*
*
        INCLUDE '(CASLIM)'
        INCLUDE '(COMPUT)'
        INCLUDE '(SOURCM)'
        INCLUDE '(FHEAVY)'
        INCLUDE '(FLKSTK)'
        INCLUDE '(GENSTK)'
        INCLUDE '(MGDDCM)'
        INCLUDE '(PAPROP)'
        INCLUDE '(QUEMGD)'
        INCLUDE '(SUMCOU)'
        INCLUDE '(TRACKR)'
*
      DIMENSION DTQUEN ( MXTRCK, MAXQMG )
*
      CHARACTER*20 FILNAM
      CHARACTER*8 MRGNAM,NRGNAM
      CHARACTER STPNAME*10
      INTEGER EV
      LOGICAL LFCOPE
      SAVE LFCOPE
      SAVE IRGDET
      SAVE EV
      SAVE STPNAME
      DATA LFCOPE / .FALSE. /
*----------------------------------------------------------------------*
*                                                                      *
*     Icode = 1: call from Kaskad                                      *
*     Icode = 2: call from Emfsco                                      *
*     Icode = 3: call from Kasneu                                      *
*     Icode = 4: call from Kashea                                      *
*     Icode = 5: call from Kasoph                                      *
*                                                                      *
*----------------------------------------------------------------------*

CALL GEOR2N ( MREG,MRGNAM, IERR1 )

C      IF (jtrack .EQ. 13 .OR. jtrack .EQ. 14) THEN
C      write(*,*) '--t-- new track',jtrack,MRGNAM
C      write(*,*) '--t-- ',jtrack
c      write(*,*) '--t-- ',ztrack(0),ztrack(1)
c      write(*,*) '--t-- ',xtrack(0),xtrack(1)
c      write(*,*) '--t-- ',ytrack(0),ytrack(1)
c      write(*,*) '--t-- ',NTRACK
c      write(*,*) '--t-- ',MTRACK
C      write(*,*) '--energy-- ',ETRACK
C      write(*,*) NTRACK,MTRACK
C
C     Store en dep in detec
      CALL GEOR2N ( MREG,   MRGNAM, IERR1 )
c SELECTING ONLY DETECTOR AND TARGET REGION
      IF (MRGNAM .EQ. 'TPix1000' .OR. MRGNAM .EQ. 'TPix2000'
     &  .OR. MRGNAM .EQ. 'TPix3000' .OR. MRGNAM .EQ. 'TPix4000' .OR.
     & MRGNAM .EQ. 'TARGET' .AND. jtrack .EQ. 2) THEN
c CHANGING DETECOTR NAME (needed for digitization)
      IF(MRGNAM .EQ. 'TPix1000') THEN
        STPNAME = 'TPix000000'
      ELSE IF(MRGNAM .EQ. 'TPix2000') THEN
        STPNAME = 'TPix100000'
      ELSE IF(MRGNAM .EQ. 'TPix3000') THEN
        STPNAME = 'TPix200000'
      ELSE IF(MRGNAM .EQ. 'TPix4000') THEN
        STPNAME = 'TPix300000'
      ELSE
        STPNAME = 'Foil'
      END IF
c SAVING DEPOSITED ENERGY
      IF (MTRACK .GT. 0) THEN
          DE =  DTRACK (NTRACK)
      END IF
c APPROXIMATING ENERGY DEPOSITION (center is ok for HIP step lower than precision requested
c not sure for gammas and electrons)
      xpos = (xtrack(0)+(xtrack(1)-xtrack(0))/2)
      ypos = (ytrack(0)+(ytrack(1)-ytrack(0))/2)
      zpos = (ztrack(0)+(ztrack(1)-ztrack(0))/2)
c COMPUTING EKIN
      IF(jtrack .GE. -6) THEN
        EKIN = ETRACK - AM (jtrack)
      ELSE
        EKIN = ETRACK - AM (j0track)
      END IF
c COMUPITING P COMPONENTS
      Px = Ptrack*Cxtrck
      Py = Ptrack*Cytrck
      Pz = Ptrack*Cztrck

c DUMPING NEEDED INFORMATION:
c # of event, PID code, detector region, energy deposited, kin energy,
c position of deposited energy, time, momentum components, track_id

      WRITE(*,*) NCASE,jtrack,STPNAME,DE,EKIN,xpos,ypos,zpos,atrack,
     & Px,Py,Pz,ISPUSR(MKBMX2)
      END IF
      RETURN

c      Ntrack,Mtrack,& ,Ttrack(1),,MRGNAM,atrack,DE,EKIN,xtrack(Ntrack),
c      &  ytrack(Ntrack),ztrack(Ntrack)

*
*======================================================================*
*                                                                      *
*     Boundary-(X)crossing DRAWing:                                    *
*                                                                      *
*     Icode = 1x: call from Kaskad                                     *
*             19: boundary crossing                                    *
*     Icode = 2x: call from Emfsco                                     *
*             29: boundary crossing                                    *
*     Icode = 3x: call from Kasneu                                     *
*             39: boundary crossing                                    *
*     Icode = 4x: call from Kashea                                     *
*             49: boundary crossing                                    *
*     Icode = 5x: call from Kasoph                                     *
*             59: boundary crossing                                    *
*                                                                      *
*======================================================================*
*                                                                      *
      ENTRY BXDRAW ( ICODE, MREG, NEWREG, XSCO, YSCO, ZSCO )
c      CALL GEOR2N ( MREG,   MRGNAM, IERR1 )
c      CALL GEOR2N ( NEWREG, NRGNAM, IERR2 )
c      IF(MRGNAM .EQ. 'VOID' .AND. NRGNAM .EQ. 'TPix1000' .OR.
c     &  MRGNAM .EQ. 'VOID' .AND. NRGNAM .EQ. 'TPix2000' .OR.
c     & MRGNAM .EQ. 'VOID' .AND. NRGNAM .EQ. 'TPix3000' .OR.
c     & MRGNAM .EQ. 'VOID' .AND. NRGNAM .EQ. 'TPix4000') THEN
c
c      write(*,*) NCASE, jtrack, ISPUSR(MKBMX2), MRGNAM, NRGNAM, XSCO, YSCO, ZSCO

c      ELSE IF(NRGNAM .EQ. 'VOID' .AND. MRGNAM .EQ. 'TPix1000' .OR.
c     &  NRGNAM .EQ. 'VOID' .AND. MRGNAM .EQ. 'TPix2000' .OR.
c     & NRGNAM .EQ. 'VOID' .AND. MRGNAM .EQ. 'TPix3000' .OR.
c     & NRGNAM .EQ. 'VOID' .AND. MRGNAM .EQ. 'TPix4000') THEN

c      write(*,*) NCASE, jtrack, ISPUSR(MKBMX2), MRGNAM, NRGNAM, XSCO, YSCO, ZSCO

c      END IF
C      write(*,*) 'NCASE',NCASE
C      write(*,*) '--t-- ',XSCO,YSCO,ZSCO
      RETURN
*
*======================================================================*
*                                                                      *
*     Event End DRAWing:                                               *
*                                                                      *
*======================================================================*
*                                                                      *
      ENTRY EEDRAW ( ICODE )
c      write(*,*) 'eedraw'
      RETURN
*
*======================================================================*
*                                                                      *
*     ENergy deposition DRAWing:                                       *
*                                                                      *
*     Icode = 1x: call from Kaskad                                     *
*             10: elastic interaction recoil                           *
*             11: inelastic interaction recoil                         *
*             12: stopping particle                                    *
*             13: pseudo-neutron deposition                            *
*             14: escape                                               *
*             15: time kill                                            *
*     Icode = 2x: call from Emfsco                                     *
*             20: local energy deposition (i.e. photoelectric)         *
*             21: below threshold, iarg=1                              *
*             22: below threshold, iarg=2                              *
*             23: escape                                               *
*             24: time kill                                            *
*     Icode = 3x: call from Kasneu                                     *
*             30: target recoil                                        *
*             31: below threshold                                      *
*             32: escape                                               *
*             33: time kill                                            *
*     Icode = 4x: call from Kashea                                     *
*             40: escape                                               *
*             41: time kill                                            *
*             42: delta ray stack overflow                             *
*     Icode = 5x: call from Kasoph                                     *
*             50: optical photon absorption                            *
*             51: escape                                               *
*             52: time kill                                            *
*                                                                      *
*======================================================================*
*                                                                      *
*  +-------------------------------------------------------------------*
*
      ENTRY ENDRAW ( ICODE, MREG, RULL, XSCO, YSCO, ZSCO )

C      CALL GEOR2N ( MREG,MRGNAM, IERR1 )

C      IF (MRGNAM .EQ. 'TPix1000' .OR. MRGNAM .EQ. 'TPix2000'
c     &    .OR. MRGNAM .EQ. 'TPix3000' .OR. MRGNAM .EQ. 'TPix4000'
c     &  .OR. MRGNAM .EQ. 'TARGET') THEN
c      IF(MRGNAM .EQ. 'al1' .OR. MRGNAM .EQ. 'TPix1000') THEN
c         STPNAME = 'TPix000000'
c      ELSE IF(MRGNAM .EQ. 'al2'.OR. MRGNAM .EQ. 'TPix2000') THEN
c         STPNAME = 'TPix100000'
c      ELSE IF(MRGNAM .EQ. 'al3'.OR. MRGNAM .EQ. 'TPix3000') THEN
c         STPNAME = 'TPix200000'
c      ELSE IF(MRGNAM .EQ. 'al4'.OR. MRGNAM .EQ. 'TPix4000') THEN
c         STPNAME = 'TPix300000'
c      END IF

c      WRITE(*,*) NCASE,jtrack,ISPUSR(MKBMX2),MRGNAM,RULL,XSCO,YSCO,ZSCO
c     & ICODE,'--edraw--'
c      END IF
      RETURN
*======================================================================*
*                                                                      *
*     SOurce particle DRAWing:                                         *
*                                                                      *
*======================================================================*
*
      ENTRY SODRAW
c      WRITE(*,*) NPFLKA,'--sodraw--'
      RETURN
*
*======================================================================*
*                                                                      *
*     USer dependent DRAWing:                                          *
*                                                                      *
*     Icode = 10x: call from Kaskad                                    *
*             100: elastic   interaction secondaries                   *
*             101: inelastic interaction secondaries                   *
*             102: particle decay  secondaries                         *
*             103: delta ray  generation secondaries                   *
*             104: pair production secondaries                         *
*             105: bremsstrahlung  secondaries                         *
*             110: radioactive decay products                          *
*     Icode = 20x: call from Emfsco                                    *
*             208: bremsstrahlung secondaries                          *
*             210: Moller secondaries                                  *
*             212: Bhabha secondaries                                  *
*             214: in-flight annihilation secondaries                  *
*             215: annihilation at rest   secondaries                  *
*             217: pair production        secondaries                  *
*             219: Compton scattering     secondaries                  *
*             221: photoelectric          secondaries                  *
*             225: Rayleigh scattering    secondaries                  *
*             237: mu pair     production secondaries                  *
*     Icode = 30x: call from Kasneu                                    *
*             300: interaction secondaries                             *
*     Icode = 40x: call from Kashea                                    *
*             400: delta ray  generation secondaries                   *
*  For all interactions secondaries are put on GENSTK common (kp=1,np) *
*  but for KASHEA delta ray generation where only the secondary elec-  *
*  tron is present and stacked on FLKSTK common for kp=npflka          *
*                                                                      *
*======================================================================*
*
      ENTRY USDRAW ( ICODE, MREG, XSCO, YSCO, ZSCO )
*
*      LLOUSE = ICODE
*
*      write(*,*) '--ic-- ',ICODE
*      IF (LANNRS .EQ. 1) THEN
*         SPAUSR (1) = XSCO
*         SPAUSR (2) = YSCO
*         SPAUSR (3) = ZSCO
*      END IF
*
*      IF (LANNFL .EQ. 1) THEN
*         SPAUSR (1) = XSCO
*         SPAUSR (2) = YSCO
*         SPAUSR (3) = ZSCO
*      END IF
*
*      IF (LELEVT .EQ. 1) THEN
*         SPAUSR (1) = XSCO
*         SPAUSR (2) = YSCO
*         SPAUSR (3) = ZSCO
*      END IF

      RETURN
*=== End of subrutine Mgdraw ==========================================*
      END
