SUBROUTINE HOWFAR C C********************************************************************* C DESIGN : D. HECK IK3 FZK KARLSRUHE C DATE : SEP 05, 1988 C********************************************************************* C THE FOLLOWING IS A GENERAL SPECIFICATION OF HOWFAR: C GIVEN A PARTICLE AT (X,Y,Z) IN REGION IR AND GOING IN DIRECTION C (U,V,W), THIS ROUTINE ANSWERS THE QUESTION, CAN THE PARTICLE GO C A DISTANCE USTEP WITHOUT CROSSING A BOUNDARY OR OBSERVATION LEVEL? C IF YES, IT CALCULATES DNEAR AND RETURNS. C IF NO, IT SETS USTEP=DISTANCE TO BOUNDARY OR DETECTOR IN C IN THE CURRENT DIRECTION. C IT SETS IRNEW TO THE REGION NUMBER ON THE FAR SIDE C OF THE BOUNDARY (THIS CAN BE MESSY IN GENERAL!); C IT SETS NEWOBS TO THE DETECTOR NUMBER NEXT AFTER THE C DETECTOR JUST PASSING. C THE USER CAN TERMINATE A HISTORY BY SETTING IDISC>0. THE USER C CAN TRANSPORT THE LAST PARTICLE BY SETTING IDISC<0. HERE WE C TERMINATE ALL HISTORIES WHICH ENTER REGION 6 OR ARE GOING C BACKWARDS IN REGION 1 OR HAVE PASSED THE LAST OBSERVATION LEVEL. C********************************************************************* C ELECTRON OR PHOTON POSITIVE Z-DIRECTION (W>0) IS DOWNWARDS C | C | REGION 1 (VACUUM) C V C--------------------------- STARTING PLANE AT -BOUND(1) = -ZALTIT C C REGION 2 (AIR WITH EXPONENTIALLY C INCREASING DENSITY) C C--------------------------- BOUNDARY AT -BOUND(2) C C REGION 3 (AIR WITH EXPONENTIALLY C INCREASING DENSITY) C C--------------------------- BOUNDARY AT -BOUND(3) C C REGION 4 (AIR WITH EXPONENTIALLY C INCREASING DENSITY) C C--------------------------- BOUNDARY AT -BOUND(4) C C REGION 5 (AIR WITH EXPONENTIALLY C INCREASING DENSITY) C C-------------------------Z=0 BOUNDARY AT -BOUND(5) (SEA LEVEL) C////////////|///////// C////////////|///////// REGION 6 (VACUUM) C////////////V///////// (MAY CONTAIN DETECTOR) C ELECTRON OR PHOTON C------------------------ BOUNDARY AT -BOUND(6) C C********************************************************************* *KEEP,EPCONT. COMMON/EPCONT/ EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC, * IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE, * TSCAT,IAUSFL DOUBLE PRECISION EDEP,RATIO REAL TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW, * EKE,ELKE,BETA2,GLE,TSCAT INTEGER IDISC,IROLD,IRNEW,IAUSFL(29) *KEND. COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10) *KEEP,OBSPAR. COMMON /OBSPAR/ OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP, * THETPR,PHIPR,NOBSLV DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10), * THETAP,THETPR(2),PHIP,PHIPR(2) INTEGER NOBSLV *KEEP,RUNPAR. COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB, * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN, * MONIOU,MDEBUG,NUCNUC, * CETAPE, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE, * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG COMMON /RUNPAC/ DSN,HOST,USER DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB REAL STEPFC INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC, * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, * N1STTR,MDBASE INTEGER CETAPE CHARACTER*79 DSN CHARACTER*20 HOST,USER LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, * FIX1I,FMUADD,FNKG,FPRINT,FDBASE * ,GHEISH,GHESIG *KEEP,STACKE. COMMON/STACKE/ E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP DOUBLE PRECISION E(60),TIME(60) REAL X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60) INTEGER IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP *KEND. COMMON/ACLOCK/NCLOCK,JCLOCK C_____IF (NCLOCK.GT.JCLOCK) THEN C______WRITE(MDEBUG,* )' HOWFAR:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP) C______CALL AUSGB2 C_____END IF IF (IR(NP).GT.1 .AND. IR(NP).LT.6) THEN C *** WE ARE IN THE ATMOSPHERE - CHECK THE GEOMETRY IRL=IR(NP) C *** GOING FORWARD - CONSIDER FIRST SINCE MOST FREQUENT NOBS=IOBS(NP) IF (W(NP).GT.0.0) THEN C *** TVAL IS DISTANCE TO NEXT BOUNDARY OR C *** OBSERVATION LEVEL IN THIS DIRECTION TVAL=(-Z(NP)-MAX(BOUND(IRL),OBSLVL(NOBS)))/W(NP) IF (TVAL.GT.USTEP) THEN C *** CAN TAKE CURRENTLY REQUESTED STEP DNEAR(NP)=TVAL*W(NP) ELSE C *** GO TO DETECTOR OR BOUNDARY, WHICH IS CLOSER USTEP=MAX(TVAL,0.0001) IF (BOUND(IRL).GE.OBSLVL(NOBS)) THEN C *** PARTICLE CROSSES BOUNDARY IRNEW=IRL+1 C *** PARTICLE LEAVES AIR IF((IRNEW.GE.6))IDISC=-1 END IF IF (BOUND(IRL).LE.OBSLVL(NOBS)) THEN C *** PARTICLE CROSSES DETECTOR NEWOBS=NOBS+1 C *** MAKE A VERY SMALL STEP TO AVOID HANGUP OF PROGRAM IF((USTEP.LE.0.0))USTEP = 0.0001 C *** TRANSPORT PARTICLE TO FINAL DETECTOR LEVEL AND DISCARD IT IF((NEWOBS.GT.NOBSLV))IDISC=-1 END IF END IF C *** END OF W(NP)>0 CASE C *** GOING UPWARD IN ATMOSPHERE ELSE IF(W(NP).LT.0.0) THEN C *** NO DETECTOR ABOVE PARTICLE IF (NOBS.LE.1) THEN C *** DISTANCE TO BOUNDARY ABOVE TVAL=(-Z(NP)-BOUND(IRL-1))/W(NP) IF (TVAL.GT.USTEP) THEN C *** CAN TAKE CURRENTLY REQUESTED STEP DNEAR(NP)=MIN(Z(NP)+BOUND(IRL-1),-(Z(NP)+BOUND(IRL))) ELSE C *** CROSS BOUNDARY ABOVE USTEP=MAX(TVAL,0.0001) IRNEW=IRL-1 END IF ELSE C *** BOUNDARY AND DETECTOR ABOVE PARTICLE TVAL=(-Z(NP)-MIN(BOUND(IRL-1),OBSLVL(NOBS-1)))/W(NP) IF (TVAL.GT.USTEP) THEN C *** CAN TAKE CURRENTLY REQUESTED STEP C *** DNEAR IS CLOSEST DISTANCE TO DETECTOR OR C *** BOUNDARY ABOVE OR BELOW PARTICLE DNEAR(NP)=MIN(Z(NP)+MIN(BOUND(IRL-1),OBSLVL(NOBS-1)), -Z(NP) + * MAX(BOUND(IRL),OBSLVL(NOBS))) ELSE C *** TAKE ONLY STEP UP TO BOUNDARY OR DETECTOR USTEP=MAX(TVAL,0.0001) IF (BOUND(IRL-1).LE.OBSLVL(NOBS-1)) THEN C *** PARTICLE CROSSES BOUNDARY ABOVE IRNEW=IRL-1 C *** PARTICLE LEAVES ATMOSPHERE IF((IRNEW.LE.1))IDISC=1 END IF IF ((BOUND(IRL-1).GE.OBSLVL(NOBS-1))) THEN C *** PARTICLE CROSSES DETECTOR ABOVE; IT IS NOT C *** PRINTED, BECAUSE IT MUST HIT DETECTOR DOWNWARDS NEWOBS=NOBS-1 IOBS(NP)=NEWOBS END IF END IF END IF C *** END W(NP)<0 CASE C *** PARTICLE IS MOVING HORIZONTALLY, CANNOT HIT BOUNDARY ELSE IF(W(NP).EQ.0.0) THEN RETURN END IF C *** END OF ATMOSPHERE REGION CASE ELSE IF(IR(NP).EQ.6) THEN C *** TERMINATE THIS HISTORY, IT IS PAST THE ATMOSPHERE IDISC=1 C *** WE ARE IN THE REGION WITH SOURCE ABOVE AIR ELSE IF(IR(NP).EQ.1) THEN IF (W(NP).GT.0.0) THEN C *** IT MUST BE A SOURCE PARTICLE ON BOUNDARY 1 USTEP=0.0001 IRNEW=2 ELSE C *** IT IS A REFLECTED PARTICLE, DISCARD IT IDISC=1 END IF C *** END REGION 1 CASE END IF RETURN END