*$ 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