*$ 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 '(IOIOCM)' INCLUDE '(CASLIM)' INCLUDE '(COMPUT)' INCLUDE '(SOURCM)' INCLUDE '(FHEAVY)' INCLUDE '(FLKSTK)' INCLUDE '(GENSTK)' INCLUDE '(MGDDCM)' INCLUDE '(PAPROP)' INCLUDE '(QUEMGD)' INCLUDE '(SUMCOU)' INCLUDE '(TRACKR)' DIMENSION DTQUEN ( MXTRCK, MAXQMG ) DIMENSION X(0:NTRACK) DIMENSION Y(0:NTRACK) DIMENSION Z(0:NTRACK) DIMENSION ENDEP(0:MTRACK-1) * CHARACTER*20 FILNAM LOGICAL LFCOPE SAVE LFCOPE DATA LFCOPE / .FALSE. / LOGICAL LFIRST SAVE LFIRST DATA LFIRST / .TRUE. / * | First call initializations: IF ( LFIRST ) THEN * | *** The following 3 cards are mandatory *** LFIRST = .FALSE. CALL myusrstart() * | *** User initialization *** END IF * *----------------------------------------------------------------------* * * * 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 * * * *----------------------------------------------------------------------* *#######################INFO ABOUT TRACKS ############################# * * KOMPUT = 9 <-- Linux system * IODRAW = unit number of the file IF((JTRACK.EQ.-6.OR.JTRACK.EQ.-2).AND.(MREG.EQ.20)) THEN DO J = 0, NTRACK X(J) = XTRACK(J) Y(J) = YTRACK(J) Z(J) = ZTRACK(J) END DO DO K = 1, MTRACK ENDEP(K-1) = DTRACK(K) END DO CALL trfill(NCASE, JTRACK, NTRACK, X, Y, Z, MTRACK, ENDEP) END IF * +-------------------------------------------------------------------* * | Quenching is activated IF ( LQEMGD ) THEN * WRITE (LNUOUT,*) 'DID YOU KNOW QUENCHING IS ACTIVE?' IF ( MTRACK .GT. 0 ) THEN RULLL = ZERZER CALL QUENMG ( ICODE, MREG, RULLL, DTQUEN ) * WRITE (IODRAW) ( ( SNGL (DTQUEN (I,JBK)), I = 1, MTRACK ), * & JBK = 1, NQEMGD ) END IF 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) 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 ) * +-------------------------------------------------------------------* * | 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(50,*)'part.', jtrack,' icode=',icode,' Edep=',rull*100000 * IF (ICODE.EQ.22) THEN * WRITE (50,*)'Eel