*$ CREATE MGDRAW.FOR
*COPY MGDRAW
*                                                                      *
*=== mgdraw ===========================================================*
*                                                                      *
      SUBROUTINE MGDRAW ( ICODE, MREG )

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 1990-2013      by        Alfredo Ferrari           *
*     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            *
*     Last change   12-Nov-13      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)'
      INCLUDE '(RDDGTR)'
      INCLUDE '(RDDGXB)'
      INCLUDE '(RDPSTK)'
      INCLUDE '(RDCYCM)'
      INCLUDE '(TMPNUC)'
*
      DIMENSION DTQUEN ( MXTRCK, MAXQMG )
*
      CHARACTER*20 FILNAM
      LOGICAL LFCOPE
      CHARACTER*8 MRGNAM, NRGNAM
      SAVE LFCOPE
      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                                      *
*                                                                      *
*----------------------------------------------------------------------*
*                                                                      *
      IF ( .NOT. LFCOPE ) THEN
         LFCOPE = .TRUE.
         IF ( KOMPUT .EQ. 2 ) THEN
            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
         ELSE
            FILNAM = CFDRAW
         END IF
         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
     &          'UNFORMATTED' )
      END IF
d      WRITE (IODRAW) NTRACK, MTRACK, JTRACK, SNGL (ETRACK),
d     &               SNGL (WTRACK)
d      WRITE (IODRAW) ( SNGL (XTRACK (I)), SNGL (YTRACK (I)),
d     &                 SNGL (ZTRACK (I)), I = 0, NTRACK ),
d     &               ( SNGL (DTRACK (I)), I = 1, MTRACK ),
d     &                 SNGL (CTRACK)
*  +-------------------------------------------------------------------*
*  |  Quenching is activated
d      IF ( LQEMGD ) THEN
d         IF ( MTRACK .GT. 0 ) THEN
d            RULLL  = ZERZER
d            CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN )
d            WRITE (IODRAW) ( ( SNGL (DTQUEN (I,JBK)), I = 1, MTRACK ),
d     &                         JBK = 1, NQEMGD )
d         END IF
d      END IF
*  |  End of quenching
*  +-------------------------------------------------------------------*
      RETURN
*
*======================================================================*
*                                                                      *
*     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 )
      CALL GEOR2N (NEWREG, MRGNAM, IEER1)
      CALL GEOR2N (MREG, NRGNAM, IEER2)
      IF (MRGNAM .EQ. "REG1" .AND. NRGNAM .EQ. "REG9") THEN
      IF (JTRACK.EQ.1) THEN
      OPEN (7, FILE='Data1.dat')
      WRITE(7,*) JTRACK, ETRACK, ATRACK, NCASE
      ENDIF
      ENDIF   
      RETURN

*
*======================================================================*
*                                                                      *
*     Event End DRAWing:                                               *
*                                                                      *
*======================================================================*
*                                                                      *
      ENTRY EEDRAW ( ICODE )
      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 )
d      IF ( .NOT. LFCOPE ) THEN
d         LFCOPE = .TRUE.
d         IF ( KOMPUT .EQ. 2 ) THEN
d            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
d         ELSE
d            FILNAM = CFDRAW
d         END IF
d         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
d     &          'UNFORMATTED' )
d      END IF
d      WRITE (IODRAW)  0, ICODE, JTRACK, SNGL (ETRACK), SNGL (WTRACK)
d      WRITE (IODRAW)  SNGL (XSCO), SNGL (YSCO), SNGL (ZSCO), SNGL (RULL)
*  +-------------------------------------------------------------------*
*  |  Quenching is activated : calculate quenching factor
*  |  and store quenched energy in DTQUEN(1, jbk)
d      IF ( LQEMGD ) THEN
d         RULLL = RULL
d         CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN )
d         WRITE (IODRAW) ( SNGL (DTQUEN(1, JBK)), JBK = 1, NQEMGD )
d      END IF
*  |  end quenching
*  +-------------------------------------------------------------------*
      RETURN
*
*======================================================================*
*                                                                      *
*     SOurce particle DRAWing:                                         *
*                                                                      *
*======================================================================*
*
      ENTRY SODRAW
d      IF ( .NOT. LFCOPE ) THEN
d         LFCOPE = .TRUE.
d         IF ( KOMPUT .EQ. 2 ) THEN
d            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
d         ELSE
d            FILNAM = CFDRAW
d         END IF
d         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
d     &          'UNFORMATTED' )
d      END IF
d      WRITE (IODRAW) -NCASE, NPFLKA, NSTMAX, SNGL (TKESUM),
d     &                SNGL (WEIPRI)



*  +-------------------------------------------------------------------*
*  |  (Radioactive) isotope: it works only for 1 source particle on
*  |  the stack for the time being
d      IF ( ILOFLK (NPFLKA) .GE. 100000 .AND. LRADDC (NPFLKA) ) THEN
d         IARES  = MOD ( ILOFLK (NPFLKA), 100000  )  / 100
d         IZRES  = MOD ( ILOFLK (NPFLKA), 10000000 ) / 100000
d         IISRES = ILOFLK (NPFLKA) / 10000000
d         IONID  = ILOFLK (NPFLKA)
d         WRITE (IODRAW) ( IONID,SNGL(-TKEFLK(I)),
d     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
d     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
d     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
d     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |  Patch for heavy ions: it works only for 1 source particle on
*  |  the stack for the time being
d      ELSE IF ( ABS (ILOFLK (NPFLKA)) .GE. 10000 ) THEN
d         IONID = ILOFLK (NPFLKA)
d         CALL DCDION ( IONID )
d         WRITE (IODRAW) ( IONID,SNGL(TKEFLK(I)+AMNHEA(-IONID)),
d     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
d     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
d     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
d     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |  Patch for heavy ions: ???
d      ELSE IF ( ILOFLK (NPFLKA) .LT. -6 ) THEN
d         WRITE (IODRAW) ( IONID,SNGL(TKEFLK(I)+AMNHEA(-ILOFLK(NPFLKA))),
d     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
d     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
d     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
d     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |
d      ELSE
d         WRITE (IODRAW) ( ILOFLK(I), SNGL (TKEFLK(I)+AM(ILOFLK(I))),
d     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
d     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
d     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
d     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
d      END IF
*  |
*  +-------------------------------------------------------------------*
      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: 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 )
d      IF ( .NOT. LFCOPE ) THEN
d         LFCOPE = .TRUE.
d         IF ( KOMPUT .EQ. 2 ) THEN
d            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
d         ELSE
d            FILNAM = CFDRAW
d         END IF
d         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
d     &          'UNFORMATTED' )
d      END IF
* No output by default:
      RETURN
*=== End of subrutine Mgdraw ==========================================*
      END

