X-Git-Url: http://git.uio.no/git/?p=u%2Fmrichter%2FAliRoot.git;a=blobdiff_plain;f=GEANT321%2Fgtrak%2Fgtmed2.F;fp=GEANT321%2Fgtrak%2Fgtmed2.F;h=0000000000000000000000000000000000000000;hp=ae693a0484d59e45ccca7fccdad281a017d641c5;hb=b9d0a01d7a0723a09071b0b56200d72f59a9c2b6;hpb=9754311559f405f3949bf48d6883dd02a93e7088 diff --git a/GEANT321/gtrak/gtmed2.F b/GEANT321/gtrak/gtmed2.F deleted file mode 100644 index ae693a0484d..00000000000 --- a/GEANT321/gtrak/gtmed2.F +++ /dev/null @@ -1,444 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1.1.1 1999/05/18 15:55:21 fca -* AliRoot sources -* -* Revision 1.1.1.1 1995/10/24 10:21:45 cernlib -* Geant -* -* -#include "geant321/pilot.h" -#if defined(CERNLIB_OLD) -*CMZ : 3.21/02 29/03/94 15.41.24 by S.Giani -*-- Author : - SUBROUTINE GTMEDI (X, NUMED) -C. -C. ****************************************************************** -C. * * -C. * Finds in which volume/medium the point X is, and updates the * -C. * common /GCVOLU/ and the structure JGPAR accordingly. * -C. * * -C. * NUMED returns the tracking medium number, or 0 if point is * -C. * outside the experimental setup. * -C. * * -C. * Note : For INWVOL = 2, INFROM set to a positive number is * -C. * interpreted by GTMEDI as the number IN of the content * -C. * just left by the current track within the mother volume * -C. * where the point X is assumed to be. * -C. * * -C. * Note : INFROM is set correctly by this routine but it is * -C. * used on entrance only in the case GSNEXT has been called * -C. * by the user. In other words the value of INFROM received * -C. * on entrance is not considered necessarily valid. This * -C. * assumption has been made for safety. A wrong value of * -C. * INFROM can cause wrong tracking. * -C. * * -C. * Called by : GTRACK * -C. * Authors : S.Banerjee, R.Brun, F.Bruyant, A.McPherson * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gctrak.inc" -#if defined(CERNLIB_USRJMP) -#include "geant321/gcjump.inc" -#endif - COMMON/GCCHAN/LSAMVL - LOGICAL LSAMVL -C. - DIMENSION X(*) - REAL XC(3), XT(3) - LOGICAL BTEST -C. -C. ------------------------------------------------------------------ -* -* SECTION I: The /GCVOLU/ table contains the initial guess for a path -* in the geometry tree on which X may be found. Look along this -* path until X is found inside. This is the starting position. -* If this is an ONLY volume with no daughters, we are done; -* otherwise reset search record variables, proceed to section II. -* -* *** Check if point is in current volume -* - INFR = 0 - INGT = 0 - JVIN = 0 -* -* *** LSAMVL is a logical variable that indicates whether we are still -* *** in the current volume or not. It is used in GTRACK to detect -* *** precision problems. - LSAMVL = .TRUE. -C***** Code Expanded From Routine: GTRNSF -C - 100 IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN - XC(1) = X(1) - GTRAN(1,NLEVEL) - XC(2) = X(2) - GTRAN(2,NLEVEL) - XC(3) = X(3) - GTRAN(3,NLEVEL) -* - ELSE - XL1 = X(1) - GTRAN(1,NLEVEL) - XL2 = X(2) - GTRAN(2,NLEVEL) - XL3 = X(3) - GTRAN(3,NLEVEL) - XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3* - + GRMAT(3,NLEVEL) - XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3* - + GRMAT(6,NLEVEL) - XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3* - + GRMAT(9,NLEVEL) - - ENDIF -C***** End of Code Expanded From Routine: GTRNSF -* - JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) -* -* Note: At entry the variable INGOTO may contain the index of a volume -* contained within the current one at NLEVEL. If so, begin by checking -* if X lies inside. This improves the search speed over that of GMEDIA. -* - NIN = Q(JVO+3) - IF ((INGOTO.LE.0).OR.(INGOTO.GT.NIN)) THEN - INGOTO = 0 - ELSE -* -* *** Entrance in content INGOTO predicted by GTNEXT -* - JIN = LQ(JVO-INGOTO) - IVOT = Q(JIN+2) - JVOT = LQ(JVOLUM-IVOT) - JPAR = LQ(JGPAR-NLEVEL-1) -* - IROTT = Q(JIN+4) -C***** Code Expanded From Routine: GITRAN -C. -C. ------------------------------------------------------------------ -C. - IF (IROTT .EQ. 0) THEN - XT(1) = XC(1) - Q(5+JIN) - XT(2) = XC(2) - Q(6+JIN) - XT(3) = XC(3) - Q(7+JIN) -* - ELSE - XL1 = XC(1) - Q(5+JIN) - XL2 = XC(2) - Q(6+JIN) - XL3 = XC(3) - Q(7+JIN) - JR = LQ(JROTM-IROTT) - XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3) - XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6) - XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9) -* - ENDIF -C***** End of Code Expanded From Routine: GITRAN -* -* * Check if point is in content -* - CALL GINME (XT, Q(JVOT+2), Q(JPAR+1), IYES) - IF (IYES.NE.0) THEN -* -* If so, prepare information for volume retrieval, and return -* - LSAMVL = .FALSE. - NL1 = NLEVEL +1 - LVOLUM(NL1) = IVOT - NAMES(NL1) = IQ(JVOLUM+IVOT) - NUMBER(NL1) = Q(JIN+3) - LINDEX(NL1) = INGOTO - LINMX(NL1) = Q(JVO+3) - GONLY(NL1) = Q(JIN+8) - IF (LQ(LQ(JVOLUM-IVOT)).EQ.0) THEN - NLDEV(NL1) = NLDEV(NLEVEL) - ELSE - NLDEV(NL1) = NL1 - ENDIF - CALL GTRMUL (GTRAN(1,NLEVEL), GRMAT(1,NLEVEL), Q(JIN+5), - + IROTT, GTRAN(1,NL1), GRMAT(1,NL1)) - NLEVEL = NL1 - XC(1) = XT(1) - XC(2) = XT(2) - XC(3) = XT(3) - JVO = JVOT - INFROM = 0 - GO TO 190 - ENDIF - ENDIF -* -* End of INGOTO processing -* - JPAR = LQ(JGPAR-NLEVEL) - CALL GINME (XC, Q(JVO+2), Q(JPAR+1), IYES) - IF (IYES.EQ.0) THEN -* -* ** Point not in current volume, go up the tree -* - LSAMVL = .FALSE. - INGOTO = 0 - IF (NLEVEL.GT.1) THEN - NLEVEL = NLEVEL -1 - JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) - NIN = Q(JVO+3) - IF(NIN.GT.0) THEN - INFROM=LINDEX(NLEVEL+1) - ELSE - INFROM=0 - ENDIF - INFR = INFROM - GO TO 100 - ELSE -* -* * Point is outside setup -* - NUMED = 0 - GO TO 999 - ENDIF - ELSE -* -* * Point in current volume but not in INGOTO. We block the -* * corresponding volume -* - IF (INGOTO.GT.0) THEN - INGT = INGOTO - JIN = LQ(JVO-INGOTO) - IQ(JIN) = IBSET(IQ(JIN),4) - ENDIF - ENDIF -* -* * Found a volume up the tree which contains our point. We block -* * the branch we came up from. -* - IF(INFR.GT.0) THEN - JIN=LQ(JVO-INFR) - IQ(JIN) = IBSET(IQ(JIN),4) - JVIN = JIN - ENDIF -* -* ** Point is in current volume -* - 190 INGOTO = 0 - NLMIN = NLEVEL - IF (INWVOL.NE.2) INFROM = 0 - NLMANY = 0 -* -* SECTION II: X is found inside current node at NLEVEL in /GCVOLU/. -* Search all contents recursively for any containing X. -* Take the first one found, if any, and continue at that -* level, incrementing NLEVEL and extending /GCVOLU/ tables. -* This is continued until a level is reached where X is not -* found in any of the contents, or there are no contents. -* Note: Since Section II is re-entered from Section III, a blocking word -* is used to mark those contents already checked. Upon exit from Section -* II, these blocking words are cleared at NLEVEL, but may remain set in -* levels between NLEVEL-1 and NLMIN, if any. They must be cleared at exit. -* -* ** Check contents, if any -* - 200 JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) - NIN = Q(JVO+3) -* -* * Case with no contents -* - IF (NIN.EQ.0) THEN - GO TO 300 -* -* * Case with contents defined by division -* - ELSEIF (NIN.LT.0) THEN - CALL GMEDIV (JVO, IN, XC, 1) - IF (IN.GT.0) THEN - INFROM = 0 - INFR = 0 - INGT = 0 - LSAMVL = .FALSE. - GO TO 200 - ENDIF -* -* * Case with contents positioned -* - ELSE - JCONT = LQ(JVO-NIN-1)+1 - NCONT = IQ(JCONT) - ISEARC = Q(JVO+1) - IF (ISEARC.LT.0) THEN -* -* Prepare access to contents, when ordered by GSORD -* - JSB = LQ(LQ(JVO-NIN-1)) - IAX = Q(JSB+1) - NSB = Q(JSB+2) - IF (IAX.LE.3) THEN - CX = XC(IAX) - ELSE - CALL GFCOOR (XC, IAX, CX) - ENDIF - IDIV = ABS(LOCATF (Q(JSB+3), NSB, CX)) - IF (IDIV.EQ.0) THEN - IF (IAX.NE.6) GO TO 260 - IDIV = NSB - ELSEIF (IDIV.EQ.NSB) THEN - IF (IAX.NE.6) GO TO 260 - ENDIF - JSC0 = LQ(JVO-NIN-2) - NCONT = IQ(JSC0+IDIV) - JCONT = LQ(JSC0-IDIV) - ELSE -* -* otherwise, scan contents (possibly a user selection of them) -* - JNEAR = LQ(JVO-NIN-1) - IF (ISEARC.GT.0) THEN -#if !defined(CERNLIB_USRJMP) - CALL GUNEAR (ISEARC, 1, XC, JNEAR) -#endif -#if defined(CERNLIB_USRJMP) - CALL JUMPT4(JUNEAR,ISEARC, 1, XC, JNEAR) -#endif - ELSEIF (INFROM.GT.0) THEN - JNUP = LQ(LQ(JVO-INFROM)-1) - IF (JNUP.GT.0) THEN - JNEAR = JNUP - ENDIF - ENDIF - JCONT = JNEAR +1 - NCONT = IQ(JCONT) - ENDIF -* -* For each selected content in turn, check if point is inside -* - DO 259 ICONT=1,NCONT - IN = IQ(JCONT+ICONT) - IF(IN.EQ.0) THEN -* -* If the value IQ(JCONT+ICONT)=0 then we are back in the mother. -* So jump to 260, the search is finished. Clean-up should be done -* only up to ICONT-1, so we set: -* - NCONT=ICONT-1 - GOTO 260 - ELSE - JIN = LQ(JVO-IN) - IF (.NOT.BTEST(IQ(JIN),4)) THEN - CALL GMEPOS (JVO, IN, XC, 1) - IF (IN.GT.0) THEN - IF (GONLY(NLEVEL).NE.0.) NLMANY = 0 - INFROM = 0 - INGT = 0 - INFR = 0 - LSAMVL = .FALSE. - GO TO 200 - ELSE - IQ(JIN) = IBSET(IQ(JIN),4) - ENDIF - ENDIF - ENDIF - 259 CONTINUE -* - 260 IF(NCONT.EQ.NIN) THEN - DO 268 IN=1,NIN - JIN = LQ(JVO-IN) - IQ(JIN) = IBCLR(IQ(JIN),4) - 268 CONTINUE - ELSE - DO 269 ICONT=1,NCONT - IN = IQ(JCONT+ICONT) - JIN = LQ(JVO-IN) - IQ(JIN) = IBCLR(IQ(JIN),4) - 269 CONTINUE - IF(INFR.NE.0) THEN - JIN = LQ(JVO-INFR) - IQ(JIN) = IBCLR(IQ(JIN),4) - INFR = 0 - ENDIF - IF(INGT.NE.0) THEN - JIN = LQ(JVO-INGT) - IQ(JIN) = IBCLR(IQ(JIN),4) - INGT = 0 - ENDIF - ENDIF -* - ENDIF -* -* SECTION III: X is found at current node (NLEVEL in /GCVOLU) but not in -* any of its contents, if any. If this is a MANY volume, -* save it as a candidate best-choice, and continue the search -* by backing up the tree one node and proceed to Section II. -* If this is an ONLY volume, proceed to Section IV. -* -* *** Point is in current volume/medium, and not in any content -* - 300 IF (GONLY(NLEVEL).EQ.0.) THEN -* -* ** Lowest level is 'NOT ONLY' -* - IF (NLEVEL.GT.NLMANY) THEN - CALL GSCVOL - NLMANY = NLEVEL - ENDIF -* -* * Go up the tree up to a volume with positioned contents -* - 310 INFROM = LINDEX(NLEVEL) - NLEVEL = NLEVEL -1 - JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) - NIN = Q(JVO+3) - IF (NIN.LT.0) GO TO 310 -* -C***** Code Expanded From Routine: GTRNSF -C - IF (GRMAT(10,NLEVEL) .EQ. 0.) THEN - XC(1) = X(1) - GTRAN(1,NLEVEL) - XC(2) = X(2) - GTRAN(2,NLEVEL) - XC(3) = X(3) - GTRAN(3,NLEVEL) -* - ELSE - XL1 = X(1) - GTRAN(1,NLEVEL) - XL2 = X(2) - GTRAN(2,NLEVEL) - XL3 = X(3) - GTRAN(3,NLEVEL) - XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + - + XL3* GRMAT(3,NLEVEL) - XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + - + XL3* GRMAT(6,NLEVEL) - XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + - + XL3* GRMAT(9,NLEVEL) -* - ENDIF -C***** End of Code Expanded From Routine: GTRNSF -* - INFR = INFROM - JIN = LQ(JVO-INFROM) - IQ(JIN) = IBSET(IQ(JIN),4) - NLMIN = MIN(NLEVEL,NLMIN) - GO TO 200 - ENDIF -* -* SECTION IV: This is the end of the search. The current node (NLEVEL -* in /GCVOLU/) is the lowest ONLY volume in which X is found. -* If X was also found in any of its contents, they are MANY -* volumes: the best-choice is the one among them at the greatest -* level in the tree, and it is stored. Otherwise the current -* volume is the solution. Before exit, all of the blocking -* words leftover in the tree must be reset to zero. -* Note: A valid structure is assumed, in which no ONLY volumes overlap. -* If this rule is violated, or if a daughter is not entirely contained -* within the mother volume, the results are unpredictable. -* - DO 419 NL=NLMIN,NLEVEL-1 - JVO = LQ(JVOLUM-LVOLUM(NL)) - NIN = Q(JVO+3) - DO 418 IN=1,NIN - JIN = LQ(JVO-IN) - IQ(JIN) = IBCLR(IQ(JIN),4) - 418 CONTINUE - 419 CONTINUE -* - IF (NLMANY.GT.0) CALL GFCVOL - JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) - IF(JVIN.NE.0) IQ(JVIN) = IBCLR(IQ(JVIN),4) - NUMED = Q(JVO+4) -* END GTMEDI - 999 IF(JGSTAT.NE.0) CALL GFSTAT(4) - END -#else - SUBROUTINE GTMED2_DUMMY - END -#endif