SUBROUTINE cmc_LIGHTF(ITRK,PTOT,XPRIME,YPRIME,XM,YM,MH) C--> MODIFIED 2/16/94 DCC ... DIM OF C_PEBEQ1 CHANGED FROM 7 TO 96 C--> ALSO REMOVED AVECOR CORRECTION <-- C************************************************************** C C--> COMPUTE LIGHT FRACTIONS... C C ITRK = TRACK # C PTOT = MOMENTUM C XPRIME = X SLOPE (DELTA(X)/DELTA(Z)) C YPRIME = Y SLOPE (DELTA(Y)/DELTA(Z)) C XME = DISTANCE TO X EDGE IN MIRROR PLANE C YME = DISTANCE TO Y EDGE IN MIRROR PLANE C XM = X POSITION IN THE MIRROR PLANE C YM = Y POSITION IN THE MIRROR PLANE C MH = MIRROR "HIT" BY TRACK C ICASE = WHICH CORNER OF THE MIRROR C ICASE = 1 ==> TOP LEFT C 2 ==> BOTTOM RIGHT C 3 ==> BOTTOM LEFT C 4 ==> TOP RIGHT C C************************************************************** C save INCLUDE 'CMC_COMMONS.FOR' DIMENSION PTH(6),AVECOR(10) C--> PTH = THRESHOLD MOMENTUM FOR E, MU, PI, K, P, & D. C--> AVECOR(I) = CORRECTION TO LIGHT = (1-PTH**2/P**2) IN TEN BINS C OF (1-PTH**2/P**2) DIMENSION REDUCE(3,2) C-->REDUCE HOLDS FRACTIONS TO REDUCE PREDICTIONS BY FOR VERTICAL BANDS C OF MIRROR "ROWS" 5 & 6 DIMENSION IX(4),IY(4),KM(4) DIMENSION NROW(96) C-->NROW(MIRROR#) = "ROW" WHICH MIRROR BELONGS TO DATA HALFX,WIDX/3.,6./ DATA PTH/0.01,1.95,2.57,9.09,17.27,34.52/ C STCM2 = SQUARE OF MAX SIN(THETAC) = (0.054)**2 = .002916 DATA STCM2/.002916/ DATA AVECOR/.40,.67,.76,.83,.86,.89,.92,.95,.97,1.0/ DATA NROW/1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4, x 1,2,3,4,1,2,3,4,5,6,7,5,6,7,7,7,7,7,5,6,7,5,6,7, x 1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4,1,2,3,4, x 1,2,3,4,5,6,7,5,6,7,7,7,7,7,5,6,7,5,6,7/ DATA REDUCE/.5,.5,.7,.2,.2,.6/ C************************************************************** C C--> COMPUTE XME & YME & DETERMINE ICASE C C--> XME AND YME ARE FIRST COMPUTED AS DISTANCES FROM THE C LOWER LEFT HAND CORNER OF THE MIRROR, & CONVERTED TO C DISTANCES FROM THE CLOSEST EDGE ONLY WHEN ICASE IS DETERMINED. HALFY=3.4641 WIDY=6.9282 IF(ABS(YM).LE.27.7128)GOTO 52 C-->DON'T CONSIDER TRACKS WHICH ARE FAR OUTSIDE OF THE ARRAY. IF(ABS(YM).GT.40.)RETURN C--> THE TRACK HITS ONE OF THE TOP OR BOTTOM MIRRORS C -OR JUST ABOVE OR BELOW THE MIRROR ARRAY. HALFY=4.83 WIDY=9.66 YME=YM-27.7128 IF(YM.GT.37.3728)YME=YM-37.3728 IF(YM.LT.0.)YME=YM+37.3728 IF(YM.LT.-37.3728)YME=YM+47.0328 C-->IF THE TRACK HITS OUTSIDE THE ARRAY IN Y, YME IS C CALCULATED FROM THE LOWER LEFT HAND CORNER OF A FICTICIOUS MIRROR GOTO 53 52 JY=YM/WIDY YME=YM-JY*WIDY IF(YM.LT.0.)YME=YME+WIDY 53 JX=XM/WIDX XME=XM-JX*WIDX IF(XM.LT.0.)XME=XME+WIDX IF(XME.GT.HALFX)GOTO 61 IF(YME.GT.HALFY)GOTO 63 C--> IF BOTH XME AND YME ARE SMALL, THIS IS CASE 3 ICASE=3 GOTO 64 61 IF(YME.GT.HALFY)GOTO 62 C--> IF XME IS BIG AND YME IS SMALL, THIS IS CASE 2 ICASE=2 XME=WIDX-XME GOTO 64 62 ICASE=4 C--> IF XME IS BIG AND YME IS BIG, THIS IS CASE 4 XME=WIDX-XME YME=WIDY-YME GOTO 64 63 ICASE=1 C--> IF XME IS SMALL AND YME IS BIG, THIS IS CASE 1 YME=WIDY-YME 64 CONTINUE DO 100 I=1,6 C--> LOOP OVER E,MU,PI,K,P,D Icmc_NMRS(ITRK,I)=0 C-->ONLY DO THE CORRECT ID IF(ICMC_ITS(ITRK).EQ.I)THEN IF(PTOT.GT.PTH(I))GOTO 5 ENDIF C-->TRACK IS BELOW THRESHOLD (OR WRONG ID) cmc_TOTL(ITRK,I)=0. cmc_PEEXP(ITRK,1,I)=0. GOTO 100 5 CONTINUE C--> FIRST COMPUTE SPOT RADIUS & OVERALL INTENSITY PL=20. + .00095*XM**2 + .5125*ABS(YM) C--> (PL = THE LENGTH OF RADIATOR THAT THE TRACK PASSED THROUGH) PLIN=(1.-PTH(I)**2/PTOT**2) IPLIN=10.*PLIN + 1. IPLIN=MIN(10,MAX(1,IPLIN)) !Added 2-18-89 lrw CDCC cmc_TOTL(ITRK,I)=PLIN*AVECOR(IPLIN) cmc_TOTL(ITRK,I)=PLIN R=PL*SQRT(cmc_TOTL(ITRK,I)*STCM2) C-->FLAG TRACKS WHICH ARE CLOSE TO THE "INNER" VERTICAL EDGE OF C ONE OF THE LARGE OUTSIDE MIRRORS IRED=0 XO=ABS(XM) IF(XO.GT.22.)THEN IF(XO.LE.28.)IRED=3 IF(XO.LE.26.)IRED=2 IF(XO.LE.24.)IRED=1 ENDIF IF(XO.GT.34.)THEN IF(XO.LE.40.)IRED=3 IF(XO.LE.38.)IRED=2 IF(XO.LE.36.)IRED=1 ENDIF C--> NOW THE PROJECTED DISTANCES. X=XME*(1.-XPRIME**2/2.)/R YS=.866 - .5*ABS(YPRIME) C--> YS = SIN(60 - YPRIME) = SIN(60)COS(YPRIME) - COS(60)SIN(YPRIME) Y=YME*YS/R DEL=0. IF(ABS(YM).GT.3.4)GOTO 16 C-->THE HIT IS NEAR THE CRACK AT Y=0... YMDEL=.06 IF(ABS(XM).GT.24.)YMDEL=.4 DEL=(YMDEL*YS)/R 16 YF=Y-DEL DO 17 IL=1,4 17 KM(IL)=IL C--> SWAP X & Y FOR CASES 3 & 4 IF(ICASE.LE.2)GOTO 20 IF(YF.LT.0.)THEN KM(1)=4 KM(4)=3 ENDIF C--> AND TABLE INDECIES DO 18 IL=2,3 IX(IL)=20.*(Y+DEL) + 1. IY(IL)=20.*X + 1. IX(IL)=MIN(21,MAX(1,IX(IL))) IY(IL)=MIN(21,MAX(1,IY(IL))) C IF(IX(IL).GT.21)IX(IL)=21 C IF(IY(IL).GT.21)IY(IL)=21 18 CONTINUE IF(YF.LT.0.)YF=-YF DO 19 IL=1,4,3 IX(IL)=20.*(YF) + 1. IY(IL)=20.*X + 1. IX(IL)=MIN(21,MAX(1,IX(IL))) IY(IL)=MIN(21,MAX(1,IY(IL))) C IF(IX(IL).GT.21)IX(IL)=21 C IF(IY(IL).GT.21)IY(IL)=21 IF(KM(IL).NE.IL)THEN ISAVE=IX(IL) IX(IL)=IY(IL) IY(IL)=ISAVE ENDIF 19 CONTINUE GOTO 244 20 CONTINUE C-->GET TABLE INDECIES FOR CASES 1&2 IF(YF.LT.0.)THEN KM(1)=2 KM(2)=3 ENDIF DO 21 IL=3,4 IY(IL)=20.*(Y+DEL) + 1. IX(IL)=20.*X + 1. IX(IL)=MIN(21,MAX(1,IX(IL))) IY(IL)=MIN(21,MAX(1,IY(IL))) C IF(IX(IL).GT.21)IX(IL)=21 C IF(IY(IL).GT.21)IY(IL)=21 21 CONTINUE IF(YF.LT.0.)YF=-YF DO 22 IL=1,2 IY(IL)=20.*(YF) + 1. IX(IL)=20.*X + 1. IX(IL)=MIN(21,MAX(1,IX(IL))) IY(IL)=MIN(21,MAX(1,IY(IL))) C IF(IX(IL).GT.21)IX(IL)=21 C IF(IY(IL).GT.21)IY(IL)=21 IF(KM(IL).NE.IL)THEN ISAVE=IX(IL) IX(IL)=IY(IL) IY(IL)=ISAVE ENDIF 22 CONTINUE 244 DO 25 J=1,4 IF(cmc_TABLE(IX(J),IY(J),KM(J)).EQ.0.)GOTO 25 NM=Icmc_MIRROR(XM,YM,ICASE,J) C-->DON'T COUNT LIGHT WHICH HITS OUTSIDE THE ARRAY (MIRROR #97) IF(NM.EQ.97)GOTO 25 IF(Icmc_NMRS(ITRK,I).EQ.0)GOTO 23 NMN=Icmc_NMRS(ITRK,I) DO 222 K=1,NMN IF(NM.NE.Icmc_MRS(ITRK,K,I))GOTO 222 L=K GOTO 232 222 CONTINUE 23 Icmc_NMRS(ITRK,I)=Icmc_NMRS(ITRK,I)+1 L=Icmc_NMRS(ITRK,I) Icmc_MRS(ITRK,L,I)=NM cmc_FLT(ITRK,L,I)=0. 232 ADDON=cmc_TABLE(IX(J),IY(J),KM(J)) IF(NROW(NM).EQ.5.OR.NROW(NM).EQ.6)THEN IF(IRED.EQ.0)GOTO 24 IF(IRED.EQ.1)THEN IF(J.NE.1)ADDON=ADDON*REDUCE(IRED,NROW(NM)-4) GOTO 24 ENDIF IF(J.NE.1)GOTO 24 ADDON=ADDON*REDUCE(IRED,NROW(NM)-4) ENDIF 24 cmc_FLT(ITRK,L,I)=cmc_FLT(ITRK,L,I)+ADDON 25 CONTINUE C-->SET cmc_TOTL=0. IF NONE OF THE LIGHT HIT A MIRROR. IF(Icmc_NMRS(ITRK,I).LE.0)THEN cmc_TOTL(ITRK,I)=0. cmc_PEEXP(ITRK,1,I)=0. GOTO 100 ENDIF L=Icmc_NMRS(ITRK,I) DO 26 J=1,L MMM=Icmc_MRS(ITRK,J,I) 26 cmc_PEEXP(ITRK,J,I)= X cmc_PEBEQ1(MMM)*cmc_FLT(ITRK,J,I)*cmc_TOTL(ITRK,I) CDCC X cmc_PEBEQ1(NROW(MMM))*cmc_FLT(ITRK,J,I)*cmc_TOTL(ITRK,I) 100 CONTINUE RETURN END