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