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

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 1990-2006      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  05-may-06       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 '(RHYMU)'
*
      DIMENSION DTQUEN ( MXTRCK, MAXQMG )
*
      CHARACTER*20 FILNAM
      LOGICAL LFCOPE
      SAVE LFCOPE
      DATA LFCOPE / .FALSE. /
* Rauls definitions start here:
*     TOP PANELS
      real preg57_energy, preg58_energy, preg59_energy, preg60_energy
      real preg61_energy, preg62_energy
*     SIDE PANELS UPPER
      real preg22_energy, preg23_energy, preg24_energy, preg25_energy
      real preg26_energy, preg27_energy, preg28_energy, preg29_energy
*     SIDE PANELS MIDDLE
      real preg38_energy, preg39_energy, preg40_energy, preg41_energy
      real preg42_energy, preg43_energy, preg44_energy, preg45_energy
*     SIDE PANELS BOTOM
      real preg30_energy, preg31_energy, preg32_energy, preg33_energy
      real preg34_energy, preg35_energy, preg36_energy, preg37_energy
*     BOTTOM PANElS
      real preg67_energy, preg68_energy, preg69_energy, preg70_energy
      real preg71_energy, preg72_energy, preg73_energy, preg74_energy
* Rauls definitions end here
*
*----------------------------------------------------------------------*
*                                                                      *
*     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
*      WRITE (IODRAW) NTRACK, MTRACK, JTRACK, SNGL (ETRACK),
*     &               SNGL (WTRACK)
*      WRITE (IODRAW) ( SNGL (XTRACK (I)), SNGL (YTRACK (I)),
*     &                 SNGL (ZTRACK (I)), I = 0, NTRACK ),
*     &               ( SNGL (DTRACK (I)), I = 1, MTRACK ),
*     &                 SNGL (CTRACK)
*  +-------------------------------------------------------------------*
*  |  Quenching is activated
      IF ( LQEMGD ) THEN
         RULLL = ZERZER
         CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN )
*         WRITE (IODRAW) ( ( SNGL (DTQUEN (I,JBK)), I = 1, MTRACK ),
*     &                      JBK = 1, NQEMGD )
      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 )
      RETURN
*
*======================================================================*
*                                                                      *
*     Event End DRAWing:                                               *
*                                                                      *
*======================================================================*
*                                                                      *
      ENTRY EEDRAW ( ICODE )
* Raul code begins here:                                                                                               
* Top panels
      if(preg57_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_57', preg57_energy
      endif
      if(preg58_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_58', preg58_energy
      endif
      if(preg59_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_59', preg59_energy
      endif
      if(preg60_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_60', preg60_energy
      endif
      if(preg61_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_61', preg61_energy
      endif
      if(preg62_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_62', preg62_energy
      endif

* Side, top row panels:
      if(preg22_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_22', preg22_energy
      endif
      if(preg23_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_23', preg23_energy
      endif
      if(preg24_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_24', preg24_energy
      endif
      if(preg25_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_25', preg25_energy
      endif
      if(preg26_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_26', preg26_energy
      endif
      if(preg27_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_27', preg27_energy
      endif
      if(preg28_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_28', preg28_energy
      endif
      if(preg29_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_29', preg29_energy
      endif


* Side, med row panels:
      if(preg38_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_38', preg38_energy
      endif
      if(preg39_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_39', preg39_energy
      endif
      if(preg40_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_40', preg40_energy
      endif
      if(preg41_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_41', preg41_energy
      endif
      if(preg42_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_42', preg42_energy
      endif
      if(preg43_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_43', preg43_energy
      endif
      if(preg44_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_44', preg44_energy
      endif
      if(preg45_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_45', preg45_energy
      endif



* Side, lower row panels:
      if(preg30_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_30', preg30_energy
      endif
      if(preg31_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_31', preg31_energy
      endif
      if(preg32_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_32', preg32_energy
      endif
      if(preg33_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_33', preg33_energy
      endif
      if(preg34_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_34', preg34_energy
      endif
      if(preg35_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_35', preg35_energy
      endif
      if(preg36_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_36', preg36_energy
      endif
      if(preg37_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_37', preg37_energy
      endif

* Bottom panels 
      if(preg67_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_67', preg67_energy
      endif
      if(preg68_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_68', preg68_energy
      endif
      if(preg69_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_69', preg69_energy
      endif
      if(preg70_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_70', preg70_energy
      endif
      if(preg71_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_71', preg71_energy
      endif
      if(preg72_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_72', preg72_energy
      endif
      if(preg73_energy.ge.0.00001) then
         write(73,120) rhy_nmu, 'fluka_panel_73', preg73_energy
      endif
      if(preg74_energy.ge.0.00001) then
         write(84,120) rhy_nmu, 'fluka_panel_74', preg74_energy
      endif


 120  format(i10, 1X, A, 1X, f12.6)
* Raul code ends here 

      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 )
      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
*      WRITE (IODRAW)  0, ICODE, JTRACK, SNGL (ETRACK), SNGL (WTRACK)
*      WRITE (IODRAW)  SNGL (XSCO), SNGL (YSCO), SNGL (ZSCO), SNGL (RULL)

*  +-------------------------------------------------------------------*
*  |  Quenching is activated : calculate quenching factor
*  |  and store quenched energy in DTQUEN(1, jbk)
      IF ( LQEMGD ) THEN
         RULLL = RULL
         CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN )
*         WRITE (IODRAW) ( SNGL (DTQUEN(1, JBK)), JBK = 1, NQEMGD )
      END IF
*  |  end quenching
* Raul code begins here:             
* Top panels                                                 
      if(MREG.eq.57) then
         preg57_energy = preg57_energy + RULL
      endif
      if(MREG.eq.58) then
         preg58_energy = preg58_energy + RULL
      endif
      if(MREG.eq.59) then
         preg59_energy = preg59_energy + RULL
      endif
      if(MREG.eq.60) then
         preg60_energy = preg60_energy + RULL
      endif
      if(MREG.eq.61) then
         preg61_energy = preg61_energy + RULL
      endif
      if(MREG.eq.62) then
         preg62_energy = preg62_energy + RULL
      endif
* Side, top row panels:
      if(MREG.eq.22) then
         preg22_energy = preg22_energy + RULL
      endif    
      if(MREG.eq.23) then
         preg23_energy = preg23_energy + RULL
      endif
      if(MREG.eq.24) then
         preg24_energy = preg24_energy + RULL
      endif
      if(MREG.eq.25) then
         preg25_energy = preg25_energy + RULL
      endif
      if(MREG.eq.26) then
         preg26_energy = preg26_energy + RULL
      endif
      if(MREG.eq.27) then
         preg27_energy = preg27_energy + RULL
      endif
      if(MREG.eq.28) then
         preg28_energy = preg28_energy + RULL
      endif
      if(MREG.eq.29) then
         preg29_energy = preg29_energy + RULL
      endif

* Side, med row panels:
      if(MREG.eq.38) then
         preg38_energy = preg38_energy + RULL
      endif
      if(MREG.eq.39) then
         preg39_energy = preg38_energy + RULL
      endif
      if(MREG.eq.40) then
         preg40_energy = preg40_energy + RULL
      endif
      if(MREG.eq.41) then
         preg41_energy = preg41_energy + RULL
      endif
      if(MREG.eq.42) then
         preg42_energy = preg42_energy + RULL
      endif
      if(MREG.eq.43) then
         preg43_energy = preg43_energy + RULL
      endif
      if(MREG.eq.44) then
         preg44_energy = preg44_energy + RULL
      endif
      if(MREG.eq.45) then
         preg45_energy = preg45_energy + RULL
      endif


* Side, lower row panels:
      if(MREG.eq.30) then
         preg30_energy = preg30_energy + RULL
      endif
      if(MREG.eq.31) then
         preg31_energy = preg31_energy + RULL
      endif
      if(MREG.eq.32) then
         preg32_energy = preg32_energy + RULL
      endif
      if(MREG.eq.33) then
         preg33_energy = preg33_energy + RULL
      endif
      if(MREG.eq.34) then
         preg34_energy = preg34_energy + RULL
      endif
      if(MREG.eq.35) then
         preg35_energy = preg35_energy + RULL
      endif
      if(MREG.eq.36) then
         preg36_energy = preg36_energy + RULL
      endif
      if(MREG.eq.37) then
         preg37_energy = preg37_energy + RULL
      endif

* Bottom panels
      if(MREG.eq.67) then
         preg67_energy = preg67_energy + RULL
      endif
      if(MREG.eq.68) then
         preg68_energy = preg68_energy + RULL
      endif
      if(MREG.eq.69) then
         preg69_energy = preg69_energy + RULL
      endif
      if(MREG.eq.70) then
         preg70_energy = preg70_energy + RULL
      endif
      if(MREG.eq.71) then
         preg71_energy = preg71_energy + RULL
      endif
      if(MREG.eq.72) then
         preg72_energy = preg72_energy + RULL
      endif
      if(MREG.eq.73) then
         preg73_energy = preg73_energy + RULL
      endif
      if(MREG.eq.74) then
         preg74_energy = preg74_energy + RULL
      endif


* Raul code ends here   
*  +-------------------------------------------------------------------*
      RETURN
*
*======================================================================*
*                                                                      *
*     SOurce particle DRAWing:                                         *
*                                                                      *
*======================================================================*
*
      ENTRY SODRAW
      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
*      WRITE (IODRAW) -NCASE, NPFLKA, NSTMAX, SNGL (TKESUM),
*     &                SNGL (WEIPRI)
*  +-------------------------------------------------------------------*
*  |  (Radioactive) isotope: it works only for 1 source particle on
*  |  the stack for the time being
      IF ( ILOFLK (NPFLKA) .GE. 100000 .AND. LRADDC (NPFLKA) ) THEN
         IARES  = MOD ( ILOFLK (NPFLKA), 100000  )  / 100
         IZRES  = MOD ( ILOFLK (NPFLKA), 10000000 ) / 100000
         IISRES = ILOFLK (NPFLKA) / 10000000
         IONID  = ILOFLK (NPFLKA)
*         WRITE (IODRAW) ( IONID,SNGL(-TKEFLK(I)),
*     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
*     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
*     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
*     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |  Patch for heavy ions: it works only for 1 source particle on
*  |  the stack for the time being
      ELSE IF ( ABS (ILOFLK (NPFLKA)) .GE. 10000 ) THEN
         IONID = ILOFLK (NPFLKA)
         CALL DCDION ( IONID )
*         WRITE (IODRAW) ( IONID,SNGL(TKEFLK(I)+AMNHEA(-IONID)),
*     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
*     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
*     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
*     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |  Patch for heavy ions: ???
      ELSE IF ( ILOFLK (NPFLKA) .LT. -6 ) THEN
*         WRITE (IODRAW) ( IONID,SNGL(TKEFLK(I)+AMNHEA(-ILOFLK(NPFLKA))),
*     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
*     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
*     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
*     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
*  |
*  +-------------------------------------------------------------------*
*  |
      ELSE
*         WRITE (IODRAW) ( ILOFLK(I), SNGL (TKEFLK(I)+AM(ILOFLK(I))),
*     &                    SNGL (WTFLK(I)), SNGL (XFLK (I)),
*     &                    SNGL (YFLK (I)), SNGL (ZFLK (I)),
*     &                    SNGL (TXFLK(I)), SNGL (TYFLK(I)),
*     &                    SNGL (TZFLK(I)), I = 1, NPFLKA )
      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                  *
*     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 )
      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
* No output by default:
      RETURN
*=== End of subrutine Mgdraw ==========================================*
      END


