*** * gxdisp.f *** * * *** MAIN PROGRAM FOR WA98 SIMULATION *** * PROGRAM GXDISP * * GEANT main program. To link with the MOTIF user interface * the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas * the routine GPAW(NWGEAN,NWPAW) gives access to the basic * graphics version. * PARAMETER (NWGEAN=9000000,NWPAW=2000000,NWKUIP=30000) COMMON/GCBANK/GEANT(NWGEAN) COMMON/PAWC/PAW(NWPAW) * CALL GPAWPP(NWGEAN,NWPAW) * END * ** * SUBROUTINE UGINIT * ************************************************************************ * * * To initialise GEANT3.21 program and read data cards * * * ************************************************************************ * PARAMETER (NWGEAN=9000000,NWPAW=2000000,NWKUIP=30000) COMMON/GCBANK/GEANT(NWGEAN) COMMON/PAWC/PAW(NWPAW) C *KEEP,GCKINE. COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD C *KEEP,GCCUTS. COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5) INTEGER LIN,LOUT,NUNITS,LUNITS COMMON/GCMAIL/CHMAIL CHARACTER*132 CHMAIL C *KEEP,GCPHYS. COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1 + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2 + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3 + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA C *KEEP,GCFLAG. COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) C *KEND. * ----------------------------------------------------------------- * * * Initialize GEANT * * CALL GINIT ! Initialize GEANT system * * --- Set the number of significant characters for FFREAD keys to 5 --- CALL FFSET('SIZE',5) * --- Define GWA98 specific FFREAD cards --- CALL SXKEY * --- Read all FFREAD data cards --- CHK We comment this out for now. CHK OPEN(25,FILE='RUNCARD.DEF',STATUS='OLD') c CALL GFFGO CHK CLOSE(25) * * * Input tracking thresholds * * CUTGAM=0.001 ! threshold for gammas transport CUTELE=0.001 ! threshold for electrons transport CUTHAD=0.01 ! threshold for hadrons transport CUTNEU=0.01 ! threshold for neutral hadrons transport CUTMUO=0.01 ! threshold for muons transport BCUTE=CUTGAM ! threshold for photons produced by electron Brems. BCUTM=CUTGAM ! threshold for photons produced by muon Brems. DCUTE=CUTELE ! threshold for electron produced by electron&delta-rays DCUTM=CUTELE ! threshold for electron produced by muon delta-rays PPCUTM=0.002 ! threshold for e+e- pair production by muons C TOFMAX=1010 ! threshold on time of flight counted C from primary interaction time * * * Input physics processes * * IPAIR=0 ! pair production with generation of electron/positron ICOMP=0 ! compton scattering with generation of electron IPHOT=0 ! photo-electric effect with generation of electron IPFIT=0 ! photo-fission effect with generation of secondaries IDRAY=0 ! delta ray production with generation of electron IANNI=0 ! positron annihilation with generation of photons IBREM=0 ! bremsstrahlung with generation of gamma IHADR=0 ! hadronic interactions with generation of secondaries IMUNU=0 ! muon nuclear interaction with generation of secondaries IDCAY=0 ! decay in flight with generation of secondaries ILOSS=0 ! continuous energy loss without generation of delta ray C and Landau-Vaviliov-Gauss fluctuations IMULS=0 ! multiple scattering according to Moli'ere theory IRAYL=0 ! Rayleigh scattering ILABS=0! absorbtion of Cerenkov photons with posssible detection ISYNC=0 ! To control synchrotron radiation ISTRA=0 ! To control energy loss fluctuation model ** * * * Initialize GEANT/ZBOOK data structures * * CALL GZINIT ! Initialize mother banks * * * Initialize graphics package * * CALL GDINIT ! Initialize drawing packag * CALL GPART ! Store the standard particle constants c CALL GMATE ! Initialize material constants * CALL UGEOM ! Define user geometry CALL GPHYSI ! Initialize GEANT physics processes * c CALL GPTMED ! Prints the tracking medium parameters * ** * * Open HBOOK * c CALL HROPEN(1,'WA98','wa98.nt','n',1024,istat) ** * * Booking Histogram & Ntuple file * c CALL HBOOKN(10,'Number of gamma',7,'WA98',5000,chtags) * * END * *** * SUBROUTINE UGLAST * ************************************************************************ * * * * * Termination routine to print histograms and statistics * * * * ************************************************************************ C *KEEP,GCOMIS. COMMON/GCOMIS/ICOMIS,JUINIT,JUGEOM,JUKINE,JUSTEP,JUOUT,JULAST C *KEND. cn.. Define of HBOOK word integer icycle C * ----------------------------------------------------------------- * IF(JULAST.NE.0)THEN CALL CSJCAL(JULAST,0,X,X,X,X,X,X,X,X,X,X) GO TO 99 ENDIF * CALL GLAST ** * * * Close HIGZ * * CALL IGEND ** * * Close Data File * CLOSE(UNIT=20) ** * * Close HBOOK * c CALL HROUT(0,icycle,' ') c CALL HREND('WA98') ** * RETURN 99 END * *** * SUBROUTINE GUKINE C. C. ****************************************************************** C. * * C. * Read or Generates Kinematics for primary tracks * C. * * C. * ==>Called by : GTRIG * C. * * C. ****************************************************************** C. *KEEP,GCFLAG COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) COMMON/GCFLAX/BATCH, NOLOG LOGICAL BATCH, NOLOG C *KEEP,GCKINE. COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD C *KEEP,GCONST. COMMON/GCONST/PI,TWOPI ,PIBY2,DEGRAD,RADDEG,CLIGHT ,BIG,EMASS COMMON/GCONSX/EMMU,PMASS,AVO C *KEEP,GCSCAN. PARAMETER (MSLIST=32,MAXMDT=3) COMMON/GCSCAN/SCANFL,NPHI,PHIMIN,PHIMAX,NTETA,TETMIN,TETMAX, + MODTET,IPHIMI,IPHIMA,IPHI1,IPHIL,NSLMAX, + NSLIST,ISLIST(MSLIST),VSCAN(3),FACTX0,FACTL, + FACTR,IPHI,ITETA,ISCUR,SX0,SABS,TETMID(MAXMDT), + TETMAD(MAXMDT) LOGICAL SCANFL COMMON/GCSCAC/SFIN,SFOUT CHARACTER*80 SFIN,SFOUT C *KEEP,GCOMIS. COMMON/GCOMIS/ICOMIS,JUINIT,JUGEOM,JUKINE,JUSTEP,JUOUT,JULAST C *KEEP,SCXGEO. C --- Common which contains some general geometry parameters --- REAL DWA98,DWMAG,DTARG $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3) $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG C REAL UBUF,PLAB(3),VERT(3) INTEGER NVTX,NT,IPART C * ----------------------------------------------------------------- * IF(JUKINE.NE.0)THEN CALL CSJCAL(JUKINE,0,X,X,X,X,X,X,X,X,X,X) GO TO 99 ENDIF * * Open Data File * if(IEVENT .eq. 1)then OPEN(UNIT=20,FILE='ascii.dat',FORM='FORAMTTED',STATUS='OLD', & ERR = 96, READONLY) DATAFILE = 'ascii.dat' endif if(ISWIT(1) .eq. 1)then CLOSE(UNIT=20) OPEN(UNIT=20,FILE='ascii.dat',FORM='FORAMTTED',STATUS='OLD', & ERR = 96, READONLY) DATAFILE = 'ascii.dat' ISWIT(1) = 0 endif C CALL E4FILE * c VERT(1) = XTARG c VERT(2) = YTARG c VERT(3) = ZTARG c CALL GSVERT(VERT,0,0,UBUF,1,NVTX) * c PLAB(1) = 0. c PLAB(2) = 0. c PLAB(3) = 2. c CALL GSKINE(PLAB,Init_PART,NVTX,UBUF,1,NT) * * * * Kinematic debug (controled by ISWIT(1)) * * c IF((IDEBUG.EQ.1).AND.(ISWIT(1).EQ.1))THEN c CALL GPRINT('VERT',0) c CALL GPRINT('KINE',0) c ENDIF * * RETURN 96 WRITE(6,*) 'Error input file :',DATAFILE 99 END * *** * SUBROUTINE GUSTEP * ************************************************************************ * * * User routine called at the end of each tracking step * * MEC is the mechanism origin of the step * * INWVOL is different from 0 when the track has reached * * a volume boundary * * ISTOP is different from 0 if the track has stopped * * * * Called by GTRACK * * * ************************************************************************ * *KEEP,GCFLAG COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) COMMON/GCFLAX/BATCH, NOLOG LOGICAL BATCH, NOLOG C * ----------------------------------------------------------------- * IF(JUSTEP.NE.0)THEN CALL CSJCAL(JUSTEP,0,X,X,X,X,X,X,X,X,X,X) GO TO 99 ENDIF * * * Print the tracking and physics * * IF(ISWIT(1).EQ.1)THEN CALL GPCXYZ ENDIF * * * Save in the stack particle generated during the current step * * IF(NGKINE.NE.0)THEN CALL GSKING(0) ENDIF * * * Stores current space point into JXYZ * * CALL GSXYZ * 99 CONTINUE END * *** * SUBROUTINE GUOUT * C. ****************************************************************** C. * * C. * User routine called at the end of each event. * C. * * C. ****************************************************************** C. *KEEP,GCFLAG. COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) C *KEEP,GCOMIS. COMMON/GCOMIS/ICOMIS,JUINIT,JUGEOM,JUKINE,JUSTEP,JUOUT,JULAST C *KEEP,GCVOLU. COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15), + LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15), + GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3) CHARACTER*4 NAMES C *KEEP,SCXGEO. C --- Common which contains some general geometry parameters --- REAL DWA98,DWMAG,DTARG $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3) $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG C *KEEP,SCXFF. C --- Common which contains FFREAD stuff for the GWA98 package --- C --- as well as the total processed event counter --- INTEGER NSXDET,NLUNS,NPLANS REAL SXGATE,SXMAGN INTEGER ISXDET,ISXDB1,ISXDB2,JDETF,ISXTRA,JTRAF,ISXDRG,JDRGF $, ISXDRT,JDRTF,IFDRAT,ISXDCH,JDCHM,JDCHN,JDCHP,ISXLUN $, ISXOUT,JOUTF,ISXPW1,ISXPW2,IMXTAR,ISXTAR,ISXTIM $, ISXPLN,JPLNF,ISXWKS,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE,IFSETS $, IFHITS,IFDIGI,IFSECS,IFXSEC,IFLOSS,ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR PARAMETER (NSXDET=15,NLUNS=8,NPLANS=15) COMMON /SCXFF/ ISXDET(NSXDET+1),ISXDB1(NSXDET+1) $, ISXDB2(NSXDET+1),JDETF(NSXDET+1) $, ISXTRA(NSXDET+1),JTRAF(NSXDET+1) $, ISXDRG(NSXDET+1),JDRGF(NSXDET+1) $, ISXDRT(NSXDET+1),JDRTF(NSXDET+1),IFDRAT $, ISXDCH,JDCHM,JDCHN,JDCHP $, ISXLUN(NLUNS),ISXOUT(NSXDET+1),JOUTF(NSXDET+1) $, ISXPW1(NSXDET+1),ISXPW2(NSXDET+1),IMXTAR $, ISXTAR,ISXTIM,SXGATE(NSXDET) $, ISXPLN(NPLANS),JPLNF(NPLANS) $, ISXWKS,SXMAGN,ISXMAP,ISXVAC,ISXTUB,NSXEVT,ISXBG1 $, ISXBG2,IFPART,IFVOLU,IFMATE,IFTMED,IFVERT,IFKINE $, IFSETS,IFHITS,IFDIGI,IFSECS $, IFXSEC,IFLOSS $, ISXEVT,ISXCHM $, MAXNSTEP $, ISXINP,ISXDIN,ISXCOOR *KEEP,user COMMON/HITDATA/HEADER CHARACTER HEADER*80 *KEND * ------------------------------------------------------------------ * IF(JUOUT.NE.0)THEN CALL CSJCAL(JUOUT,0,X,X,X,X,X,X,X,X,X,X) GO TO 99 ENDIF * CALL ICLRWK(0,0) ** * * Draw track of particle and detector * * if( ISWIT(5) .eq. 0 )then if( ISWIT(6) .eq. 1 )then CALL GDRAW('WA98',140.,120.,0.,25.,20.,0.025,0.025) elseif( ISWIT(6) .eq. 2)then CALL GDRAW('WA98',90.,180.,0.,21.,10.,0.012,0.012) elseif( ISWIT(6) .eq. 3)then CALL GDRAW('WA98',90.,90.,0.,21.,8.,0.012,0.012) elseif( ISWIT(6) .eq. 4)then CALL GDRAW('WA98',90.,90.,0.,50.,8.,0.035,0.035) elseif( ISWIT(6) .eq. 7)then CALL GDRAW('WA98',40.,60.,0.,6.,5.,0.012,0.012) elseif( ISWIT(6) .eq. 8)then CALL GDRAW('WA98',150.,90.,0.,10.,15.,0.012,0.012) elseif( ISWIT(6) .eq. 9)then CALL GDRAW('WA98',30.,90.,0.,10.,5.,0.012,0.012) else CALL GDRAW('WA98',140.,120.,0.,14.,15.,0.012,0.012) endif * CALL IGSET('TXCI',4.) CALL GDHITS('PAD1','*',20,850,0.1) CALL GDHITS('PAD1','*',30,850,0.1) CALL GDHITS('PAD1','*',40,842,0.2) CALL IGSET('TXCI',3.) CALL GDHITS('PAD2','*',20,850,0.1) CALL GDHITS('PAD2','*',30,850,0.1) CALL GDHITS('PAD2','*',40,842,0.2) CALL IGSET('TXCI',2.) CALL GDHITS('STR1','*',20,850,0.1) CALL GDHITS('STR1','*',30,850,0.1) CALL GDHITS('STR1','*',40,842,0.2) CALL IGSET('TXCI',7.) CALL GDHITS('STR2','*',20,850,0.1) CALL GDHITS('STR2','*',30,850,0.1) CALL GDHITS('STR2','*',40,842,0.2) CALL IGSET('TXCI',4.) CALL GDHITS('JTOF','*',20,850,0.1) CALL GDHITS('JTOF','*',30,850,0.1) CALL GDHITS('JTOF','*',40,842,0.2) * CALL IGSET('TXCI',1.) CALL GDHEAD(1,HEADER,0.4) CALL GDXYZ(0) CALL GDAXIS(XTARG,YTARG,ZTARG,100.) CALL GDPART(0,11,0.25) CALL GDMAN(18.,4.0) CALL GDSCAL(2.,2.) endif CALL GPHITS('****','****') WRITE(6,*) HEADER * RETURN 99 END * *** * SUBROUTINE E4FILE * C. ****************************************************************** C. * * C. * Open and Read Data File C. * * C. ****************************************************************** C. *KEEP,GCFLAG COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) COMMON/GCFLAX/BATCH, NOLOG LOGICAL BATCH, NOLOG C *KEEP,SCXGEO. C --- Common which contains some general geometry parameters --- REAL DWA98,DWMAG,DTARG $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3) $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG C *KEEP,user COMMON/HITDATA/HEADER CHARACTER HEADER*80 *KEND C CHARACTER DATAFILE*40,CLINE*60 INTEGER ID, IDATA(10), NUMBV, IHIT INTEGER IRUN, IEVE, ITRI, ITYP ! ID = 2 or 3 INTEGER ITRK ! ID = 4 REAL XTRK(3), DXTRK(3),CHISQ ! ID = 4 INTEGER NHIT,NDET,NDHIT(5) c INTEGER C REAL LX,LY,GX(3),HITS(3),UBUF INTEGER I,J,NVTX,NT C * ----------------------------------------------------------------- save IRUN, IEVE, ITRI, ITYP * * Read Data File * CALL VZERO(IDATA,10) CALL VZERO(NDHIT,5) CALL VZERO( NHIT,1) C 10 READ(20,'(A)',ERR=97,END=99) CLINE c WRITE(6,*)CLINE READ(CLINE,*,ERR=98) ID,IDATA C 50 FORMAT(A3,I5,A7,I4,A4,I2,A4,I2,A4,I2,A4,I2,A4,I2,A4,I2) * * ID = 2 * ISWIT(2).eq.0 : All event * ISWIT(2).eq.1 : Only hitting event * if(ID .eq.20)then if(ISWIT(2).eq.0)then if(IDATA(2) .eq. 1)then IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) goto 10 else WRITE(HEADER,50,ERR=96) 'RUN',IRUN,'EVENT',IEVE, & 'ID=',ID,'P1.',NDHIT(1),'P2.',NDHIT(2), & 'S1.',NDHIT(3),'S2.',NDHIT(4),'TF.',NDHIT(5) IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) CALL VZERO(NDHIT,5) CALL VZERO( NHIT,1) RETURN endif elseif(ISWIT(2).eq.1)then if(NHIT .gt. 0)then WRITE(HEADER,50,ERR=96) 'RUN',IRUN,'EVENT',IEVE, & 'ID=',ID,'P1.',NDHIT(1),'P2.',NDHIT(2), & 'S1.',NDHIT(3),'S2.',NDHIT(4),'TF.',NDHIT(5) BACKSPACE(20) RETURN else IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) CALL VZERO(NDHIT,5) CALL VZERO( NHIT,1) endif endif elseif(ID .eq.21)then NDHIT(1) = NDHIT(1) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(1,LX,LY,GX,HITS) CALL GSAHIT(1,1,20,NUMBV,HITS,IHIT) elseif(ID .eq. 22)then NDHIT(2) = NDHIT(2) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(2,LX,LY,GX,HITS) CALL GSAHIT(2,1,20,NUMBV,HITS,IHIT) elseif(ID .eq.23)then NDHIT(3) = NDHIT(3) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(3,LX,LY,GX,HITS) CALL GSAHIT(3,1,20,NUMBV,HITS,IHIT) elseif(ID .eq.24)then NDHIT(4) = NDHIT(4) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(4,LX,LY,GX,HITS) CALL GSAHIT(4,1,20,NUMBV,HITS,IHIT) elseif(ID .eq.25)then NDHIT(5) = NDHIT(5) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(5,LX,LY,GX,HITS) CALL GSAHIT(5,1,20,NUMBV,HITS,IHIT) endif * * ID = 3 * ISWIT(3).eq.0 : All event * ISWIT(3).eq.1 : Only hitting event * if(ID .eq.30)then if(ISWIT(3).eq.0)then if(IDATA(2) .eq. 1)then IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) goto 10 else WRITE(HEADER,50,ERR=96) 'RUN',IRUN,'EVENT',IEVE, & 'ID=',ID,'P1.',NDHIT(1),'P2.',NDHIT(2), & 'S1.',NDHIT(3),'S2.',NDHIT(4),'TF.',NDHIT(5) IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) CALL VZERO(NDHIT,5) CALL VZERO( NHIT,1) RETURN endif elseif(ISWIT(3).eq.1)then if(NHIT .gt. 0)then WRITE(HEADER,50,ERR=96) 'RUN',IRUN,'EVENT',IEVE, & 'ID=',ID,'P1.',NDHIT(1),'P2.',NDHIT(2), & 'S1.',NDHIT(3),'S2.',NDHIT(4),'TF.',NDHIT(5) BACKSPACE(20) RETURN else IRUN = IDATA(1) IEVE = IDATA(2) ITRI = IDATA(3) ITYP = IDATA(4) CALL VZERO(NDHIT,5) CALL VZERO( NHIT,1) endif endif elseif(ID .eq.31)then NDHIT(1) = NDHIT(1) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(1,LX,LY,GX,HITS) CALL GSAHIT(1,1,30,NUMBV,HITS,IHIT) elseif(ID .eq. 32)then NDHIT(2) = NDHIT(2) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(2,LX,LY,GX,HITS) CALL GSAHIT(2,1,30,NUMBV,HITS,IHIT) elseif(ID .eq.33)then NDHIT(3) = NDHIT(3) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(3,LX,LY,GX,HITS) CALL GSAHIT(3,1,30,NUMBV,HITS,IHIT) elseif(ID .eq.34)then NDHIT(4) = NDHIT(4) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(4,LX,LY,GX,HITS) CALL GSAHIT(4,1,30,NUMBV,HITS,IHIT) elseif(ID .eq.35)then NDHIT(5) = NDHIT(5) + 1 NHIT = NHIT + 1 LX = float(IDATA(1))/10. LY = float(IDATA(2))/10. CALL E4LTOG(5,LX,LY,GX,HITS) CALL GSAHIT(5,1,30,NUMBV,HITS,IHIT) endif * * ID = 4 * if(ID .eq.40)then ITRK = IDATA(1) XTRK(1) = float(IDATA(2))/10. XTRK(2) = float(IDATA(3))/10. XTRK(3) = float(IDATA(4))/10. + ZMAG DXTRK(1) = float(IDATA(5))/10. DXTRK(2) = float(IDATA(6))/10. DXTRK(3) = float(IDATA(7))/10. CHISQ = IDATA(8)/100. c WRITE(6,*)' XTRK =',XTRK(1),XTRK(2),XTRK(3)-ZMAG c WRITE(6,*)'DXTRK =',DXTRK CALL GSVERT(XTRK,0,0,UBUF,1,NVTX) CALL GSKINE(DXTRK,8,NVTX,UBUF,1,NT) elseif(ID .eq.41)then ITRK = IDATA(1) HITS(1) = float(IDATA(2))/10. HITS(2) = float(IDATA(3))/10. HITS(3) = float(IDATA(4))/10. + ZMAG CALL GSAHIT(1,1,40,NUMBV,HITS,IHIT) elseif(ID .eq. 42)then ITRK = IDATA(1) HITS(1) = float(IDATA(2))/10. HITS(2) = float(IDATA(3))/10. HITS(3) = float(IDATA(4))/10. + ZMAG CALL GSAHIT(2,1,40,NUMBV,HITS,IHIT) elseif(ID .eq.43)then ITRK = IDATA(1) HITS(1) = float(IDATA(2))/10. HITS(2) = float(IDATA(3))/10. HITS(3) = float(IDATA(4))/10. + ZMAG CALL GSAHIT(3,1,40,NUMBV,HITS,IHIT) elseif(ID .eq.44)then ITRK = IDATA(1) HITS(1) = float(IDATA(2))/10. HITS(2) = float(IDATA(3))/10. HITS(3) = float(IDATA(4))/10. + ZMAG CALL GSAHIT(4,1,40,NUMBV,HITS,IHIT) elseif(ID .eq.45)then ITRK = IDATA(1) HITS(1) = float(IDATA(2))/10. HITS(2) = float(IDATA(3))/10. HITS(3) = float(IDATA(4))/10. + ZMAG CALL GSAHIT(5,1,40,NUMBV,HITS,IHIT) endif * * goto 10 96 WRITE(6,*)'Error at E4FILE : write HEADER' 97 WRITE(6,*)'Error at E4FILE : read DATA' 98 WRITE(6,*)'Error at E4FILE : read CLINE' 99 END * *** * SUBROUTINE E4LTOG(IDET,LX,LY,GX,WX) * ************************************************************************ * Transform coordinate from the local(each detector) * to the global(zero point is the center of magnet) * and to the GWA98 frame. * * IDET ; INPUT : detector number * #1=PAD1, #2=PAD2, #3=STR1, #4=STR2, #5=JTOF * LX ; INPUT : X position in the local * LY ; INPUT : Y position in the local * GX(3) ; OUTPUT : array of 3 containing the position in the global * WX(3) ; OUTPUT : array of 3 containing the position in the GWA98 * ************************************************************************ * *KEEP,SCXGEO. C --- Common which contains some general geometry parameters --- REAL DWA98,DWMAG,DTARG $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG COMMON /SCXGEO/ DWA98(3),DWMAG(3),DTARG(3) $, DWA98X,DWA98Y,DWA98Z $, DMAGNX,DMAGNY,DMAGNZ $, DTARGX,DTARGY,DTARGZ $, XTARG,YTARG,ZTARG,XMAG,YMAG,ZMAG C *KEEP,SC4FFK. C --- Common with the users defined FFKEY cards REAL THEARM,TLTTOF,DJTOF COMMON /SC4FFK/ THEARM,TLTTOF,DJTOF C *KEEP,SCFFFK. C --- Common with the users defined FFKEY cards REAL THEARM2,TLTPAD1,TLTPAD2,TLTSTR1,TLTSTR2,TLTTUB, 1 DPAD1,DPAD2,DSTR1,DSTR2 COMMON /SCFFFK/ THEARM2,TLTPAD1,TLTPAD2,TLTSTR1,TLTSTR2,TLTTUB, 1 DPAD1,DPAD2,DSTR1,DSTR2 C *KEND. INTEGER IDET REAL LX,LY,GX(3),WX(3) REAL CONV /0.017453/ ! Stupid conversion factor Pi/180 REAL DIST,TARM,TTLT C * DIST ; distance of chamber edge from the center of magnet * TARM ; Angle of Second Arm Axis * TTLT ; Tilted Angle of Chamber to the Second Arm Axis C * ----------------------------------------------------------------- * if(IDET .eq. 1)then DIST = DPAD1 TARM = THEARM TTLT = TLTPAD1 elseif(IDET .eq.2)then DIST = DPAD2 TARM = THEARM TTLT = TLTPAD2 elseif(IDET .eq.3)then DIST = DSTR1 TARM = THEARM TTLT = TLTSTR1 elseif(IDET .eq.4)then DIST = DSTR2 TARM = THEARM TTLT = TLTSTR2 elseif(IDET .eq.5)then DIST = DJTOF TARM = THEARM TTLT = TLTTOF else DIST = 0. TARM = 0. TTLT = 0. endif C GX(1) = DIST*sin(TARM*CONV) + LX*cos((TARM+TTLT)*CONV) GX(2) = LY GX(3) = DIST*cos(TARM*CONV) - LX*sin((TARM+TTLT)*CONV) C WX(1) = GX(1) WX(2) = GX(2) WX(3) = GX(3) + ZMAG C RETURN END