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

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     MaGnetic field trajectory DRAWing: actually this entry manages   *
*                                        all trajectory dumping for    *
*                                        drawing                       *
*                                                                      *
*     Created by                     Alfredo Ferrari                   *
*                                    INFN - Milan                      *
*     last change  10-nov-02  by     Alfredo Ferrari                   *
*                                    INFN - Milan                      *
*                                                                      *
*----------------------------------------------------------------------*
*
      INCLUDE '(CASLIM)'
      INCLUDE '(COMPUT)'
      INCLUDE '(EPISOR)'
      INCLUDE '(FHEAVY)'
      INCLUDE '(FINUC)'
      INCLUDE '(MGDDCM)'
      INCLUDE '(PAPROP)'
      INCLUDE '(STACK)'
      INCLUDE '(STARS)'
      INCLUDE '(TRACKR)'
      COMMON /XXXEVENTSTACKXXX/IGLPRTCNTXX,JTRACKSTRXX(5000)
      COMMON /XXEVENTSTACKXX/ENGYXX(5000),AGETXX(5000),
     &                       XTRCKXX(5000),YTRCKXX(5000),ZTRCKXX(5000),
     &                      DXTRCKXX(5000),DYTRCKXX(5000),DZTRCKXX(5000)
*
c      CHARACTER*20 FILNAM
      DATA RdErth/637814000./
      LOGICAL LFCOPE
      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.
c         IF ( KOMPUT .EQ. 2 ) THEN
c            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
c         ELSE
c            FILNAM = CFDRAW
c         END IF
c         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
c     &          'UNFORMATTED' )
      END IF
c      WRITE (IODRAW) NTRACK, MTRACK, JTRACK, SNGL (ETRACK),
c     &               SNGL (WTRACK)
c      WRITE (IODRAW) ( SNGL (XTRACK (I)), SNGL (YTRACK (I)),
c     &                 SNGL (ZTRACK (I)), I = 0, NTRACK ),
c     &               ( SNGL (DTRACK (I)), I = 1,MTRACK ),
c     &                 SNGL (CTRACK)
      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 )

c        IF((MREG.eq.184.and.NEWREG.eq.2).or.
c     &      (MREG.eq.2.and.NEWREG.eq.184)) then
c     &      (MREG.eq.2.and.NEWREG.eq.3).or.
c     &      (MREG.eq.3.and.NEWREG.eq.2).or.
c     &      (MREG.eq.3.and.NEWREG.eq.4).or.
c     &      (MREG.eq.4.and.NEWREG.eq.3).or.
c     &      (MREG.eq.4.and.NEWREG.eq.5).or.
c     &      (MREG.eq.5.and.NEWREG.eq.4).or.
c     &      (MREG.eq.5.and.NEWREG.eq.6).or.
c     &      (MREG.eq.6.and.NEWREG.eq.5).or.
c     &      (MREG.eq.6.and.NEWREG.eq.7).or.
c     &      (MREG.eq.7.and.NEWREG.eq.6).or.
c     &      (MREG.eq.7.and.NEWREG.eq.8).or.
c     &      (MREG.eq.8.and.NEWREG.eq.7))then
c     &      (MREG.eq.14.and.NEWREG.eq.15).or.
c     &      (MREG.eq.15.and.NEWREG.eq.14).or.
c     &      (MREG.eq.21.and.NEWREG.eq.22).or.
c     &      (MREG.eq.22.and.NEWREG.eq.21).or.
c     &      (MREG.eq.29.and.NEWREG.eq.30).or.
c     &      (MREG.eq.30.and.NEWREG.eq.29).or.
c     &      (MREG.eq.42.and.NEWREG.eq.43).or.
c     &      (MREG.eq.43.and.NEWREG.eq.42).or.
c          IF(
c     &      (MREG.eq.181.and.NEWREG.eq.182).or.
c     &      (MREG.eq.54.and.NEWREG.eq.55).or.
c     &      (MREG.eq.55.and.NEWREG.eq.54)) THEN

        IF((MREG.eq.184.and.NEWREG.eq.2).or.
     &      (MREG.eq.2.and.NEWREG.eq.184).or.
     &      (MREG.eq.2.and.NEWREG.eq.3).or.
     &      (MREG.eq.3.and.NEWREG.eq.2).or.
     &      (MREG.eq.3.and.NEWREG.eq.4).or.
     &      (MREG.eq.4.and.NEWREG.eq.3)) then

d           WRITE(95,100) mreg,NEWREG,jtrack,etrack-am(jtrack),CXTRCK,
d     &     CYTRCK,CZTRCK,XSCO, YSCO, ZSCO-RdErth,atrack
        IGLPRTCNTXX=IGLPRTCNTXX+1
        JTRACKSTRXX(IGLPRTCNTXX)=jtrack
        ENGYXX(IGLPRTCNTXX)=etrack-am(jtrack)
        AGETXX(IGLPRTCNTXX)=atrack
        XTRCKXX(IGLPRTCNTXX)=XSCO
        YTRCKXX(IGLPRTCNTXX)=YSCO
        ZTRCKXX(IGLPRTCNTXX)=ZSCO-RdErth
        DXTRCKXX(IGLPRTCNTXX)=CXTRCK
        DYTRCKXX(IGLPRTCNTXX)=CYTRCK
        DZTRCKXX(IGLPRTCNTXX)=CZTRCK

         ENDIF
 100   FORMAT ('S',1X,I3,2(1X,I3),4(1X,E13.6),3(1X,F13.0),1X,E13.6)


      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                                            *
*     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.
c         IF ( KOMPUT .EQ. 2 ) THEN
c            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
c         ELSE
c            FILNAM = CFDRAW
c         END IF
c         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
c     &          'UNFORMATTED' )
      END IF
c      WRITE (IODRAW)  0, ICODE, JTRACK, SNGL (ETRACK), SNGL (WTRACK)
c      WRITE (IODRAW)  SNGL (XSCO), SNGL (YSCO), SNGL (ZSCO), SNGL (RULL)
      RETURN
*
*======================================================================*
*                                                                      *
*     SOurce particle DRAWing:                                         *
*                                                                      *
*======================================================================*
*
      ENTRY SODRAW
      IF ( .NOT. LFCOPE ) THEN
         LFCOPE = .TRUE.
c         IF ( KOMPUT .EQ. 2 ) THEN
c            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
c         ELSE
c            FILNAM = CFDRAW
c         END IF
c         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
c     &          'UNFORMATTED' )
      END IF
c      WRITE (IODRAW) -NCASE, LSTACK, LSTMAX, SNGL (TKESUM),
c     &                SNGL (WEIPRI)
*  +-------------------------------------------------------------------*
*  |  Patch for heavy ions: it works only for 1 source particle on
*  |  the stack for the time being
c      IF ( ABS (ILO(LSTACK)) .GE. 10000 ) THEN
c         IONID = ILO (LSTACK)
c         CALL DCDION ( IONID )
c         WRITE (IODRAW) ( IONID,SNGL(TKE(I)+AMNHEA(-IONID)),SNGL(WT(I)),
c     &                    SNGL (XA(I)), SNGL (YA(I)), SNGL (ZA(I)),
c     &                    SNGL (TX(I)), SNGL (TY(I)), SNGL (TZ(I)),
c     &                    I = 1, LSTACK )
*  |
*  +-------------------------------------------------------------------*
*  |
c      ELSE
c         WRITE (IODRAW) ( ILO(I), SNGL (TKE(I)+AM(ILO(I))), SNGL(WT(I)),
c     &                    SNGL (XA(I)), SNGL (YA(I)), SNGL (ZA(I)),
c     &                    SNGL (TX(I)), SNGL (TY(I)), SNGL (TZ(I)),
c     &                    I = 1, LSTACK )
c      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                         *
*     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 FINUC common (kp=1,np)  *
*  but for KASHEA delta ray generation where only the secondary elec-  *
*  tron is present and stacked on STACK common for kp=lstack           *
*                                                                      *
*======================================================================*
*
      ENTRY USDRAW ( ICODE, MREG, XSCO, YSCO, ZSCO )
c      IF ( .NOT. LFCOPE ) THEN
c         LFCOPE = .TRUE.
c         IF ( KOMPUT .EQ. 2 ) THEN
c            FILNAM = '/'//CFDRAW(1:8)//' DUMP A'
c         ELSE
c            FILNAM = CFDRAW
c         END IF
c         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
c     &          'UNFORMATTED' )
c      END IF
* No output by default:
      RETURN
*=== End of subrutine Mgdraw ==========================================*
      END


