*** * s6code.f *** * *+PATCH,S6CODE. *CMZ : 1.00/00 08/10/90 17.54.45 by Nick van Eijndhoven (CERN) *+DECK,BLANK. *CMZ : 1.00/00 08/10/90 17.54.45 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 08/10/90 C ******************************************************************** C *** Simulation code for the PMD *** C ******************************************************************** *+DECK,S6KEY. *CMZ : 2.05/36 22/06/95 21.00.54 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 17.34.40 by Hal Kalechofsky *CMZ : 2.05/28 16/06/95 16.39.02 by Hal Kalechofsky *CMZ : 2.05/22 12/06/95 11.11.47 by Hal Kalechofsky *-- Author : SUBROUTINE S6KEY C C *********************************************************************** C * * C * Definition of FFREAD Keys * C * * C *********************************************************************** C * * C * CALLED BY : SXKEY * C * CONTACT : * C * * C * ORIGIN : C * REWRITTEN : C * MODIFICATIONS : * C * * C *********************************************************************** IMPLICIT NONE *KEEP,SC6FFK. C --- Common with the users defined FFKEY cards INTEGER INAME1,INAME2,IMIX1 REAL SNAME1,SNAME2,SMIX2,SMIX3 COMMON /SC6FFK/INAME1,INAME2,SNAME1,SNAME2,IMIX1,SMIX2,SMIX3 *KEEP,END. * Here write comments for each card. Transfer the same comments to the * runcards file. * In the examples the data cards are EXMP1, EXMP2 and EXMP3. * The first one has two Integer variables, INAME1 and INAME2 that can * take the values that the user specifies from the runcards file. * Similarly the EXMP2 has 2 real variables while the EXMP3 has 3 mixed * variables * * DATA CARD : EXMP1 * to control the ........... * INAME1 = 100 ==> .... * INAME1 = 200 ==> .... * * INAME2 = 1000 ==> ... * INAME2 = 2000 ==> ... * * * DATA CARD : EXMP2 * to control the ........... * SNAME1 = 100. ==> .... * SNAME1 = 200. ==> .... * * SNAME2 = 1000. ==> ... * SNAME2 = 2000. ==> ... * C INAME1 = 100 C INAME2 = 1000 C CALL FFKEY('EXMP1',INAME1, 2,'INTEGER') C C SNAME1 = 100.0 C SNAME2 = 1000.0 C CALL FFKEY('EXMP2',SNAME1, 2,'REAL') C C IMIX1 = 0 C SMIX2 = 0. C SMIX3 = 0. c CALL FFKEY( 'EXMP3',IMIX1,3,'MIXE' ) 9999 CONTINUE RETURN END *+DECK,S6MATE. *CMZ : 2.06/16 01/08/95 15.58.35 by Hal Kalechofsky *CMZ : 2.06/15 01/08/95 15.31.47 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 16.52.16 by Hal Kalechofsky *CMZ : 1.00/00 15/04/91 21.45.43 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 08/10/90 SUBROUTINE S6MATE C C *********************************************************************** C * * C * Definition of Material for PMD Code * C * * C *********************************************************************** C * * C * CALLED BY : SXMATE * C * CONTACT : * C * * C * ORIGIN : NICK VAN EIJNDHOVEN * C * REWRITTEN : * C * MODIFICATIONS : * C * * C *********************************************************************** C C IMPLICIT NONE REAL AP(2),ZP(2),WP(2),AL(3),ZL(3),WL(3) REAL DP,DL C --- Polysterene scintillator (CH) --- DATA AP /12.,1./,ZP /6.,1./,WP /1.,1./,DP /1.032/ C --- Lucite wavelength shifter (C5H8O2) --- $, AL /12.,1.,16./,ZL /6.,1.,8./,WL /5.,8.,2./,DL /1.18/ C C --- Define the various materials for GEANT --- CALL GSMATE(600,'Fe $', 55.85,26., 7.87,1.76,17.1,0,0) CALL GSMATE(601,'Pb $',207.19,82.,11.35,0.56,18.5,0,0) CALL GSMATE(603,'Al $', 26.98,13., 2.70,8.90,37.2,0,0) CALL GSMATE(698,'Vacuum$',1.E-16,1.E-16,1.E-16,1.E16,1.E16,0,0) CALL GSMATE(699,'Air $',14.61,7.3,0.001205,30420.,67500.,0,0) C --- Define the various mixtures for GEANT --- CALL GSMIXT(602,'Polystyrene$',AP,ZP,DP,-2,WP) CALL GSMIXT(604,'Lucite $',AL,ZL,DL,-3,WL) C RETURN END *+DECK,S6TMED. *CMZ : 2.06/16 01/08/95 15.58.35 by Hal Kalechofsky *CMZ : 2.06/15 01/08/95 15.31.47 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 11.36.12 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 16.45.45 by Hal Kalechofsky *CMZ : 1.00/00 27/02/92 13.43.39 by Nick van Eijndhoven (RUU/CERN) *-- Author : Nick van Eijndhoven (CERN) 08/10/90 SUBROUTINE S6TMED C C *********************************************************************** C * * C * Definition of Media for PMD Code * C * * C *********************************************************************** C * * C * CALLED BY : SXTMED * C * CONTACT : * C * * C * ORIGIN : NICK VAN EIJNDHOVEN * C * REWRITTEN : * C * MODIFICATIONS : * C * * C *********************************************************************** C IMPLICIT NONE CALL GSTMED(600,'Fe plate$',600,0,0,0.,10.,1.,0.1,0.01,0.05,0,0) CALL GSTMED(601,'Pb conv.$',601,0,0,0.,10.,1.,0.1,0.01,0.10,0,0) CALL GSTMED(602,'Scintill$',602,1,0,0.,10.,1.,0.1,0.01,0.03,0,0) CALL GSTMED(603,'Al plate$',603,0,0,0.,10.,1.,0.1,0.01,0.01,0,0) CALL GSTMED(604,'WLS fibr$',604,1,0,0.,10.,1.,0.1,0.01,0.01,0,0) CALL GSTMED(698,'Vacuum $',698,0,0,0.,10.,1.,0.1,0.10,10.0,0,0) CALL GSTMED(699,'Air gaps$',699,0,0,0.,10.,1.,0.1,0.10,0.10,0,0) C C --- Generate explicitly delta rays in the iron and lead --- CALL GSTPAR(600,'LOSS',3.) CALL GSTPAR(600,'DRAY',1.) CALL GSTPAR(601,'LOSS',3.) CALL GSTPAR(601,'DRAY',1.) C C --- Set Birks factors for the scint. and W-L shifters --- CALL GSTPAR(602,'BIRK1',1.) CALL GSTPAR(602,'BIRK2',0.013) CALL GSTPAR(602,'BIRK3',9.6E-6) CALL GSTPAR(604,'BIRK1',1.) CALL GSTPAR(604,'BIRK2',0.013) CALL GSTPAR(604,'BIRK3',9.6E-6) C C --- Energy cut-offs in the Pb and scint. to gain time in tracking --- C --- without affecting the hit patterns --- CALL GSTPAR(601,'CUTGAM',1.E-4) CALL GSTPAR(601,'CUTELE',1.E-4) CALL GSTPAR(601,'CUTNEU',1.E-4) CALL GSTPAR(601,'CUTHAD',1.E-4) CALL GSTPAR(602,'CUTGAM',1.E-4) CALL GSTPAR(602,'CUTELE',1.E-4) CALL GSTPAR(602,'CUTNEU',1.E-4) CALL GSTPAR(602,'CUTHAD',1.E-4) C RETURN END *+DECK,S6GEOM. *CMZ : 2.06/15 01/08/95 15.31.47 by Hal Kalechofsky *CMZ : 2.05/29 21/06/95 11.36.12 by Hal Kalechofsky *CMZ : 2.02/00 15/03/95 09.00.04 by Unknown *-- Author : Nick van Eijndhoven (CERN) 08/10/90 *-- Author : Nick van Eijndhoven (CERN) 08/10/90 SUBROUTINE S6GEOM C C *********************************************************************** C * * C * Definition of PMD Geometry * C * * C *********************************************************************** C * * C * CALLED BY : SXGEOM * C * CONTACT : * C * * C * ORIGIN : NICK VAN EIJNDHOVEN * C * REWRITTEN : SUBHASIS CHATTOPADHYAY,VECC,CALCUTTA,INDIA. C * MODIFICATIONS : C * * C *********************************************************************** C IMPLICIT NONE *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,SC6POS. C --- Common which contains the detector position in the WA98 frame --- REAL XC,YC,ZC COMMON /SC6POS/ XC,YC,ZC C *KEEP,SC6STA. C --- Common which contains arrays for event statistics --- INTEGER NPAD,NSTR PARAMETER(NSTR=38,NPAD=50) REAL EDEPS COMMON /SC6STA/ EDEPS(38,50,28) C C REAL DPMD(3),DPHOL(3) C REAL PARFE1(3),PARFE2(3),PARFE3(3),PARFE4(3) REAL PARPB1(3),PARPB2(3),PARPB3(3),PARPB4(3) REAL PARSC1(3),PARSC2(3),PARSC3(3),PARSC4(3) REAL XX(28),YY(28) REAL XP,YP,ZP,ZSP,ZPP,ZFP,ZDIST CHK REAL XC,YC,ZC,ZSP1,ZPP1,ZFP1 REAL ZSP1,ZPP1,ZFP1 CHK REAL XTARG,YTARG,ZTARG,ZSP2,ZPP2,ZFP2 REAL ZSP2,ZPP2,ZFP2 REAL ZSP3,ZPP3,ZFP3 INTEGER IROT(28),I C DATA DPMD /350.,215.,12.50 / DATA DPHOL / 53.9,58.9,12.50 / C DATA IROT/4*601,2*0,4*601,3*0,2*605,2*0,2*604,0, x 2*601,3*603,3*602/ c DATA PARFE1/38.40,29.45,0.25/ DATA PARFE2/50.9,38.8,0.25/ DATA PARFE3/58.9,44.45,0.25/ DATA PARFE4/63.45,48.25,0.25/ C DATA PARPB1/38.40,29.45,0.85/ DATA PARPB2/50.9,38.8,0.85/ DATA PARPB3/58.9,44.45,0.85/ DATA PARPB4/63.45,48.25,0.85/ C DATA PARSC1/38.40,29.45,0.15/ DATA PARSC2/50.9,38.8,0.15/ DATA PARSC3/58.9,44.45,0.15/ DATA PARSC4/63.45,48.25,0.15/ C DATA XX/-88.35,-29.45,29.45,88.35,2*92.3,88.35, 1 29.45,-29.45,-88.35,2*-92.3,-168.7,-50.9, 1 50.9,2*168.7,50.9,-50.9,-168.7,-175.15, 1 175.15,3*283.05,3*-283.05 / DATA YY/4*97.3,29.45,-29.45,4*-97.3,-29.45,29.45, 1 97.3,2*174.5,97.3,-97.3,2*-174.5,-97.3, 1 2*0.,96.5,0.,2*-96.5,0.,96.5 / C C *** Define the PMD box volume and fill with air *** CALL GSVOLU('PMD ','BOX ',699,DPMD,3,I) C --- Place the PMD in WA98 with front edge 21.50m from target --- ZDIST = 2150. XP=XTARG YP=YTARG ZP=ZTARG+DPMD(3)+ZDIST XC=XP-XTARG YC=YP-YTARG ZC=ZDIST CALL GSPOS('PMD ',1,'WA98',XP,YP,ZP,0,'ONLY') C C *** Define the various planes in the PMD *** C C --- The iron plates for different cameras --- CALL GSVOLU('PFE1','BOX ',600,PARFE1,3,I) CALL GSVOLU('PFE2','BOX ',600,PARFE2,3,I) CALL GSVOLU('PFE3','BOX ',600,PARFE3,3,I) CALL GSVOLU('PFE4','BOX ',600,PARFE4,3,I) C --- The lead plates for different cameras --- CALL GSVOLU('PPB1','BOX ',601,PARPB1,3,I) CALL GSVOLU('PPB2','BOX ',601,PARPB2,3,I) CALL GSVOLU('PPB3','BOX ',601,PARPB3,3,I) CALL GSVOLU('PPB4','BOX ',601,PARPB4,3,I) C C category 1 --- padsize = 1.5 cm. (12 camera) C --- The scintillator pad plane --- CALL GSVOLU('PSC1','BOX ',602,PARSC1,3,I) C --- Divide the scintillator plane in horizontal strips --- CALL GSDVN('PST1','PSC1',38,2) C --- Divide each strip horizontally in pads --- CALL GSDVN('PAD1','PST1',50,1) C category 2 --- padsize = 2.0 cm. (8 camera) C --- The scintillator pad plane --- CALL GSVOLU('PSC2','BOX ',602,PARSC2,3,I) C --- Divide the scintillator plane in horizontal strips --- CALL GSDVN('PST2','PSC2',38,2) C --- Divide each strip horizontally in pads --- CALL GSDVN('PAD2','PST2',50,1) C category 3 --- padsize = 2.3 cm. (2 camera) C --- The scintillator pad plane --- CALL GSVOLU('PSC3','BOX ',602,PARSC3,3,I) C --- Divide the scintillator plane in horizontal strips --- CALL GSDVN('PST3','PSC3',38,2) C --- Divide each strip horizontally in pads --- CALL GSDVN('PAD3','PST3',50,1) C category 4 --- padsize = 2.5 cm. (6 camera) C --- The scintillator pad plane --- CALL GSVOLU('PSC4','BOX ',602,PARSC4,3,I) C --- Divide the scintillator plane in horizontal strips --- CALL GSDVN('PST4','PSC4',38,2) C --- Divide each strip horizontally in pads --- CALL GSDVN('PAD4','PST4',50,1) C C make call to set rotation matrix for boxes CALL GSROTM(601,90.,90.,90.,0.,0.,0.) C Another rotation matrix for two wings C --- Right part tilted 8 degrees inwards --- CALL GSROTM(602,82.,0.,90.,90.,8.0,180.0) C --- Left part tilted 8 degrees inwards --- CALL GSROTM(603,98.,0.,90.,90.,8.0,0.0) c Rotation matrices for top and bottom part C --- Top part tilted 8 degrees inwards --- CALL GSROTM(604,90.,0.,82.,90.,8.0,270.0) C --- Bottom part tilted 8 degrees inwards --- CALL GSROTM(605,90.,0.,98.,90.,8.0,90.0) C C --- Place the various planes inside the PMD --- C --- Start with the iron at the front edge of the PMD --- ZFP=.01+PARFE1(3)-DPMD(3) ZPP=ZFP+PARFE1(3)+PARPB1(3) ZSP=ZPP+PARPB1(3)+PARSC1(3) C positioning of cameras C C POSITIONING OF 15mm BOXES DO 10 I=1,12 c first place the iron plates CALL GSPOSP('PFE1',I,'PMD ',XX(I),YY(I),ZFP,IROT(I), $'ONLY',PARFE1,3) C Now place the lead plates CALL GSPOSP('PPB1',I,'PMD ',XX(I),YY(I),ZPP,IROT(I), $'ONLY',PARPB1,3) C Now place the Scintillator plates CALL GSPOSP('PSC1',I,'PMD ',XX(I),YY(I),ZSP,IROT(I), $'ONLY',PARSC1,3) 10 CONTINUE C C POSITIONING OF 20mm AND 23mm BOXES DO 20 I=13,22 c At first two 23mm boxes IF(I.EQ.21.OR. I.EQ.22) THEN c first place the iron plates CALL GSPOSP('PFE3',I,'PMD ',XX(I),YY(I),ZFP,IROT(I), $'ONLY',PARFE3,3) C Now place the lead plates CALL GSPOSP('PPB3',I,'PMD ',XX(I),YY(I),ZPP,IROT(I), $'ONLY',PARPB3,3) C Now place the Scintillator plates CALL GSPOSP('PSC3',I,'PMD ',XX(I),YY(I),ZSP,IROT(I), $'ONLY',PARSC3,3) C ELSEIF(I.EQ.14.OR. I.EQ.15) THEN c FOR TWO TOP 20mm BOXES, Z AND YY COORDINATES ARE CHANGED C IN ORDER THAT AFTER ROTATION BY 8 DEG BOTTOM PART OF THE BOXES C TOUCH THE UPPER EDGE OF 12mm BOXES yy(i)=yy(i)-(1-.9902)*parfe2(2) zfp2=zfp-0.1391*parfe2(2) zpp2=zpp-0.1391*parfe2(2) zsp2=zsp-0.1391*parfe2(2) c first place the iron plates CALL GSPOSP('PFE2',I,'PMD ',XX(I),YY(I),ZFP2,IROT(I), $'ONLY',PARFE2,3) c now place the lead plates CALL GSPOSP('PPB2',I,'PMD ',XX(I),YY(I),ZPP2,IROT(I), $'ONLY',PARPB2,3) c now place the scintillator plates CALL GSPOSP('PSC2',I,'PMD ',XX(I),YY(I),ZSP2,IROT(I), $'ONLY',PARSC2,3) C ELSEIF(I.EQ.18.OR. I.EQ.19) THEN C FOR TWO BOTTOM 20mm BOXES, Z AND YY COORDINATES ARE CHANGED C IN ORDER THAT AFTER ROTATION BY 8 DEG TOP PART OF THE BOXES C TOUCH THE LOWER EDGE OF 12mm BOXES yy(i)=yy(i)-(1-.9902)*parfe2(2) zfp3=zfp-0.1391*parfe2(2) zpp3=zpp-0.1391*parfe2(2) zsp3=zsp-0.1391*parfe2(2) c first place the iron plates CALL GSPOSP('PFE2',I,'PMD ',XX(I),YY(I),ZFP3,IROT(I), $'ONLY',PARFE2,3) c now place the lead plates CALL GSPOSP('PPB2',I,'PMD ',XX(I),YY(I),ZPP3,IROT(I), $'ONLY',PARPB2,3) c now place the scintillator plates CALL GSPOSP('PSC2',I,'PMD ',XX(I),YY(I),ZSP3,IROT(I), $'ONLY',PARSC2,3) ELSE C C PLACE OTHER 20mm BOXES c first place the iron plates CALL GSPOSP('PFE2',I,'PMD ',XX(I),YY(I),ZFP,IROT(I), $'ONLY',PARFE2,3) c now place the lead plates CALL GSPOSP('PPB2',I,'PMD ',XX(I),YY(I),ZPP,IROT(I), $'ONLY',PARPB2,3) c now place the scintillator plates CALL GSPOSP('PSC2',I,'PMD ',XX(I),YY(I),ZSP,IROT(I), $'ONLY',PARSC2,3) ENDIF C 20 CONTINUE C C NOW 25mm BOXES TO BE PLACED C DO 30 I=23,28 c FOR TWO 25mm BOXES ON THE RIGHT, Z AND XX COORDINATES C ARE CHANGED IN ORDER THAT AFTER ROTATION OBY 8 DEG C LEFT SIDES OF THE BOXES TOUCH THE OTHER INNER BOXES c AND FOR TWO 25mm BOXES ON THE LEFT, Z AND XX COORDINATES C ARE CHANGED IN ORDER THAT AFTER ROTATION BY 8 DEG C RIGHT EDGES OF THE BOXES TOUCH THE OTHER INNER BOXES C if(i.ge.23.and.i.le.25)xx(i)=xx(i)-(1-.9902)*parfe4(1) if(i.ge.26.and.i.le.28)xx(i)=xx(i)+(1-.9902)*parfe4(1) zfp1=zfp-0.1391*parfe4(1) CALL GSPOSP('PFE4',I,'PMD ',XX(I),YY(I),ZFP1,IROT(I), $'ONLY',PARFE4,3) zpp1=zpp-0.1391*parpb4(1) CALL GSPOSP('PPB4',I,'PMD ',XX(I),YY(I),ZPP1,IROT(I), $'ONLY',PARPB4,3) zsp1=zsp-0.1391*parsc4(1) CALL GSPOSP('PSC4',I,'PMD ',XX(I),YY(I),ZSP1,IROT(I), $'ONLY',PARSC4,3) 30 CONTINUE C C --- Make the central hole in the PMD and fill with vacuum --- CALL GSVOLU('PHOL','BOX ',698,DPHOL,3,I) CALL GSPOS('PHOL',1,'PMD ',0.,0.,0.,0,'ONLY') C C --- Set the seen attributes for the drawings --- CALL GSATT('PMD ','SEEN',1) CALL GSATT('PHOL','SEEN',-2) CALL GSATT('PFE1','SEEN',-2) CALL GSATT('PFE2','SEEN',-2) CALL GSATT('PFE3','SEEN',-2) CALL GSATT('PFE4','SEEN',-2) CALL GSATT('PPB1','SEEN',-2) CALL GSATT('PPB2','SEEN',-2) CALL GSATT('PPB3','SEEN',-2) CALL GSATT('PPB4','SEEN',-2) CALL GSATT('PSC1','SEEN',-2) CALL GSATT('PSC2','SEEN',-2) CALL GSATT('PSC3','SEEN',-2) CALL GSATT('PSC4','SEEN',-2) C RETURN END *+DECK,S6SENS. *CMZ : 2.06/15 01/08/95 15.31.47 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 16.49.03 by Hal Kalechofsky *CMZ : 1.00/00 08/10/90 17.54.45 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 08/10/90 SUBROUTINE S6SENS C C *********************************************************************** C * * C * Definition of Sensitive Elements for PMD s * C * * C *********************************************************************** C * * C * CALLED BY : SXSENS * C * CONTACT : * C * * C * ORIGIN : NICK VAN EIJNDHOVEN * C * REWRITTEN : SUBHASIS CHATTOPADHYAY,VECC,CALCUTTA,INDIA. C * MODIFICATIONS : C * * C *********************************************************************** C IMPLICIT NONE INTEGER NV,NH PARAMETER (NV=4) PARAMETER (NH=2) C CHARACTER*4 NAMESV(NV),NAMESH(NH) INTEGER NBITSV(NV),NBITSH(NH),ISET,IDET REAL ORIG(NH),FACT(NH) C DATA NBITSV / NV*8 / DATA NBITSH / NH*24 / DATA ORIG / NH*0. / DATA FACT / NH*100000. / C NAMESH(1)='PART' NAMESH(2)='ELOS' C C --- Define each scintillator pad as sensitive detector --- NAMESV(1)='PMD ' NAMESV(2)='PSC1' NAMESV(3)='PST1' NAMESV(4)='PAD1' call GSDET('PMD ','PAD1',4,NAMESV,NBITSV,601,1000,1000,ISET,IDET) CALL GSDETH('PMD ','PAD1',NH,NAMESH,NBITSH,ORIG,FACT) NAMESV(1)='PMD ' NAMESV(2)='PSC2 ' NAMESV(3)='PST2' NAMESV(4)='PAD2' CALL GSDET('PMD ','PAD2',4,NAMESV,NBITSV,602,1000,1000,ISET,IDET) CALL GSDETH('PMD ','PAD2',NH,NAMESH,NBITSH,ORIG,FACT) NAMESV(1)='PMD ' NAMESV(2)='PSC3 ' NAMESV(3)='PST3' NAMESV(4)='PAD3' CALL GSDET('PMD ','PAD3',4,NAMESV,NBITSV,603,1000,1000,ISET,IDET) CALL GSDETH('PMD ','PAD3',NH,NAMESH,NBITSH,ORIG,FACT) NAMESV(1)='PMD ' NAMESV(2)='PSC4 ' NAMESV(3)='PST4' NAMESV(4)='PAD4' CALL GSDET('PMD ','PAD4',4,NAMESV,NBITSV,604,1000,1000,ISET,IDET) CALL GSDETH('PMD ','PAD4',NH,NAMESH,NBITSH,ORIG,FACT) C NAMESV(1)='PMD ' C NAMESV(2)='PSC5 ' C NAMESV(3)='PST5' C NAMESV(4)='PAD5' C CALL GSDET('PMD ','PAD5',4,NAMESV,NBITSV,604,1000,1000,ISET,IDET) C CALL GSDETH('PMD ','PAD5',NH,NAMESH,NBITSH,ORIG,FACT) RETURN END *+DECK,S6DRAW. *CMZ : 2.06/16 01/08/95 15.58.35 by Hal Kalechofsky *CMZ : 2.06/15 01/08/95 15.31.47 by Hal Kalechofsky *CMZ : 1.01/00 14/07/94 16.49.35 by Hal Kalechofsky *CMZ : 1.00/00 08/10/90 17.54.45 by Nick van Eijndhoven (CERN) *-- Author : Nick van Eijndhoven (CERN) 08/10/90 SUBROUTINE S6DRAW C C *********************************************************************** C * * C * Drawing PMD s * C * * C *********************************************************************** C * * C * CALLED BY : SXDRAW * C * CONTACT : * C * * C * ORIGIN : NICK VAN EIJNDHOVEN * C * REWRITTEN : C * MODIFICATIONS : C * * C *********************************************************************** C IMPLICIT NONE C%%% CALL GDTREE('PMD ',0,011111) CALL GDFSPC('PMD ',0,0) RETURN END