*file member=mcvx_backtrack library=snoman language=fortran77
*file date=17:Jan:1998
      integer function mcvx_backtrack( l_mcvx,
     +                                 vx_class,
     +                                 test_type,
     +                                 test_args )
 
*     Utility to backtrack up an MCVX/MCTK chain looking for required vertex.
 
*     Contact:  N. West, Oxford.
*     Verified:
*     Refereed:
 
*     Parameters:-
*     ==========
 
*     l_mcvx    in      Link to starting point MCVX.
*               out     Link to backtracked MCVX ( or =0 if backtrack fails)
*     vx_class  in      Required vertex class.
*     test_type in      Required vertex test. See Specification.
*     test_args in      Test arguments.  See Specification.
*     mcvx_backtrack
*               out     Link to MCTK from backtracked MCVX that leads to
*                       staring point MCVX. = 0 if backtrack fails.
 
*     Common Block Access:-
*     ===================
*     (ignoring internal and environmental access)
 
*     /Z/        in     Banks: MCVX, MCTK.
*
 
*     Specification:-
*     =============
 
* o   From supplied MCVX, step back via its incident MCTK to the MCVX
*     that preceded it.
 
* o   Apply vertex test there.  If test fails, step back again.  Repeat
*     until test suceeds or MCVX/MCTK chain exhausted.
 
* o   Vertex tests currently supported:-
*
*     Vertex    Test    Test    Description
*     Class     Type    Args
*
*     any       0       -       Vertex is of required class
*     2         1       ARG1    Vertex is boundary with ARG1 as the region
*                               type of incident track (KMCVX_RGN).
*     3         1       ARG1    Vertex is an interaction with ARG1 as the
*                               process code of its interaction.
 
*     Program Notes:-
*     =============
 
*     The routine is called by the DQF MCVX_BACKTRACK.  NTP converts the
*     arguments supplied by the user to integer before calling.
 
*     Revision History:-
*     ================
 
*     3.01  N. West     First version.
 
      implicit none
 
      include 'z.inc'
 
      include 'bank_mcvx.inc'
 
 
*     Argument Declarations:-
*     =====================
 
      integer           l_mcvx, vx_class, test_type, test_args(2)
 
*endheader
 
*     Local Variable Declarations:-
*     ===========================
 
      integer           l_mctk, arg1, mcvx_4h
      logical           quit
 
      data              mcvx_4h / 4hMCVX /
 
 
 
      arg1 = test_args(1)
 
*     Check that user has suplied an MCVX!
      if ( l_mcvx .ne. 0 .and. iq(l_mcvx-4) .ne. mcvx_4h ) l_mcvx = 0
 
*     Step back once before starting to test.
      l_mctk = 0
      if ( l_mcvx .ne. 0 ) l_mctk = lq(l_mcvx - KMCVX_MCTKI)
      l_mcvx = 0
      if ( l_mctk .ne. 0 ) l_mcvx = lq(l_mctk + 1)
 
**    Loop until required vertex found or MCVX/MCTK chain exhausted.
 
      quit = l_mcvx .eq. 0
 
      do while ( .not. quit )
 
**      Apply vertex class test.
 
        if ( iq(l_mcvx+KMCVX_CLS) .eq. vx_class ) then
 
**        Now apply class-specific tests.
 
          if ( test_type .eq. 0 ) then
 
*           Any vertex satisfies test 0.
            quit = .true.
 
          elseif ( test_type .eq. 1 ) then
 
*           Check for boundary to required region.
            if ( vx_class .eq. KMCVX_BOU ) then
              quit =  arg1 .eq. iq(l_mcvx+KMCVX_RGN)/10000
 
*           Check for interaction with required process code.
            elseif( vx_class .eq. KMCVX_INT ) then
              quit = arg1 .eq. mod( iq(l_mcvx+KMCVX_INC)/1000, 1000 )
 
            endif
 
          endif
 
        endif
 
*       If vertex failed, step back.
        if ( .not. quit ) then
          l_mctk = lq(l_mcvx - KMCVX_MCTKI)
          if ( l_mctk .ne. 0 ) then
            l_mcvx = lq(l_mctk + 1)
          else
            l_mcvx = 0
            quit   = .true.
          endif
        endif
 
      enddo
 
*     Return track from backtracked vertex.
      mcvx_backtrack = l_mctk
 
      return
      end
*endfile member=mcvx_backtrack
