*$ 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 '(EMFSTK)'
      INCLUDE '(RESNUC)'

*
      DIMENSION DTQUEN ( MXTRCK, MAXQMG )
      CHARACTER*8 MRGNAM, NRGNAM
      CHARACTER*20 FILNAM
      LOGICAL LFCOPE
      SAVE LFCOPE
      DATA LFCOPE / .FALSE. /
      LOGICAL UDFIRST
      DATA UDFIRST / .TRUE. /
      SAVE UDFIRST
*  +-------------------------------------------------------------------*
*  |  Quenching is activated
      IF ( LQEMGD ) THEN
         IF ( MTRACK .GT. 0 ) THEN
            RULLL  = ZERZER
            CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN )
            WRITE(31) B,REAL(NCASE), REAL(JTRACK),
     &              (SNGL(DTQUEN (1,JBK)), JBK = 1, NQEMGD),
     &              SNGL(DTRACK(1))
         END IF
      END IF
*  |  End of quenching
*  +-------------------------------------------------------------------*
      CALL GEOR2N ( MREG, MRGNAM, IERR1 )
      IF (MRGNAM.EQ.'TARG') THEN
        DO J = 1,MTRACK
            ERULL0 = ERULL0 + DTRACK(J)
        ENDDO
      ENDIF
      RETURN
*                                                                      *
      ENTRY BXDRAW ( ICODE, MREG, NEWREG, XSCO, YSCO, ZSCO )
      RETURN
*
*======================================================================*
*                                                                      *
*     Event End DRAWing:                                               *
*                                                                      *
*======================================================================*
*                                                                      *
      ENTRY EEDRAW ( ICODE )
      RETURN
*
*                                                                      *
      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 =
     &          'FORMATTED' )
      END IF
      IF (MRGNAM.EQ.'TARG') THEN
        DO J = 1,MTRACK
            ERULL0 = ERULL0 + RULL
            WRITE (IODRAW,*)  NTRACK,MTRACK,DTRACK(J),ZTRACK(J)
        ENDDO
      ENDIF
*  +-------------------------------------------------------------------*
*  |  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 )
         OPEN ( UNIT = IODRAW, FILE = FILNAM, STATUS = 'NEW', FORM =
     &          'FORMATTED' )
         WRITE (IODRAW,*) (SNGL (DTQUEN(1, JBK)), JBK = 1, NQEMGD )
      END IF
*  |  end quenching
*  +-------------------------------------------------------------------*
      RETURN
*
*======================================================================*
*                                                                      *
*     SOurce particle DRAWing:                                         *
*                                                                      *
*======================================================================*
*
      ENTRY SODRAW
      RETURN
*
      ENTRY USDRAW ( ICODE, MREG, XSCO, YSCO, ZSCO )
      IF ( UDFIRST ) THEN
         UDFIRST = .FALSE.
      ENDIF
         WRITE (IODRAW,*) 'P ',NCASE,JTRACK,NPFLKA,ICODE,
     & NP,NPHEAV,ETRACK-AM(JTRACK),XSCO,YSCO,ZSCO,WTRACK
*
* Boucle sur particules secondaires
      do 10 ip = 1, NP
         WRITE (IODRAW,*) '2nd ',NCASE,JTRACK,
     & ip,ICODE,ZPART,APART,TKI(ip),CXR(ip),CYR(ip),
     & CZR(ip),WEI(ip)
*
10    continue
* Boucle sur les electrons
      do 20 ip=1,NP
         WRITE (IODRAW,*)'El ', ICHEMF(ip),
     & ICODE, ETEMF(ip), XEMF(ip), YEMF(ip),ZEMF(ip)
*
20    continue
      do 30 ip=1,NPHEAV
         WRITE (IODRAW,*) 'Heav', NCASE, JTRACK,
     & ip,ICODE,KHEAVY(ip),ICHEAV(KHEAVY(ip)),IBHEAV(KHEAVY(ip)),
     & TKHEAV(ip)
30    continue
      RETURN
*==== end of subrutine Mgdraw =========================================*
      END
