Subroutine CTDCORR(status)
*Start_doc
C#@ Phantom routine to correct VCTRAK momenta for low value of B-field
C#
C#  Brief summary:
C#  --------------
C# High statistics studies of various mass peaks (J/psi, D etc.) suggest, 
C# very strongly, that the magnetic field used by VCTRAK is TOO LOW by 
C# about 0.3%.
C#
C# So, for REAL DATA ONLY, this routine corrects the momentum by multiplying 
C#         ************** 
C# the quantity VCTRHL_pgevc by FACTOR, where FACTOR is set to 1.003.
C# 
C# VCTRHL_pgevc is the ONLY quantity which is SCALED, since 
C# VCTPAR momenta are (effectively) scaled by VCTRHL_pgevc.
C# Also we deliberately do NOT scale VCATCAL etc. as these quantities
C# may be used for track swimming with the UNscaled B field.
C# 
C# CTDCORR should be called after the unpacking of compressed VC tables,
C#  i.e. after Call VCGETREG, or after VCGETCTD.
C#  It IS meaningful to call it TWICE per event, once after VCGETREG
C#    and once after VCGETCTD.
C#
C# Calling arguments:
C# ------------------
C#     Input:    None
C#     Output:   
C#                 status =  1  if routine was called and executed successfully,
C#                               but no correction was applied.
C#                               (eg Monte Carlo, redundant call for event,..)
C#                 status =  0  if routine was called and executed successfully,
C#                               and the correction was applied.
C#                 status = -1  unable to determine what to do...
C#                               (eg required tables not available or similar.)
C#                               No correction applied.   
C#                   
C#
C#  Details of what routine does:
C#  -----------------------------
C#    
C#     - check for MCarlo, by looking for MOZART entry in EvHMM table,
C#                                     or entries in FMCKIN,
C#                                     if YES, status=1 and return
C#
C#     - check for redundant call:
C#        Given the 'modular' nature of ZEUS s/ware, it is logically
C#        correct for each of several different analysis packages to
C#        call eg VCGETCTD, and then want to call CTDCORR.
C#        So same event/run-number as last call to CTDCORR is NOT
C#        a sufficient reason for doing nothing!
C#        Rather one must check the VALUE of VCTRHL_pgevc against its
C#        source VCTKSCTD_R(4) or VCTKSREG_R(4).
C#
C#    - to establish 'source' (REG or CTDonly) of VCTRHL:
C#       I check on bit-for-bit equality of :
C#           VCTRHL_qovr and VCTKSREG|CTD_R(1)
C#           VCTRHL_qxdh and VCTKSREG|CTD_R(2)
C#           VCTRHL_zh   and VCTKSREG|CTD_R(3)
C#
C#    - and then finally one gets to the loop over all entries in VCTRHL
C#       and multiplication by FACTOR.
C#
*End_doc
C
C
      Implicit NONE
C
#include "partap.inc"
#include "vctksreg.inc"
#include "vctksctd.inc"
#include "vctrhl.inc"
#include "evhmm.inc"
#include "zrevt.inc"
#include "fmckin.inc"
C
      Integer status
C
C define the scale factor:
      Real       FACTOR
      Parameter (FACTOR = 1.003)
C
      Integer Last_r, Last_ev
      Save    Last_r, Last_ev
      Data    Last_r/-1/, Last_ev/-1/
      Logical New_event

      Integer NROW,ip, KASE
      character*6 evname
      Real        orig
C
C Monte Carlo?
C ************
C
      status = 1
      if(CouTab(FMCKIN).gt.0)   GO TO 999
C
      NROW = Coutab(EVHMM)
      if(NROW.le.0) then 
        status = -1
        GO TO 999
      endif
C
         do 10 ip = 1,NROW
           call FetTab(EVHMM,ID,ip)
           evname = EVHMM_jobname(1:6)
           call CLtoU(evname(1:6))
           if(evname.eq.'MOZART') GO TO 999
 10      continue
C 
C Real Data:
C **********
C
      NROW = Coutab(VCTRHL)
      if(NROW.le.0)                   GO TO 999
      if(CouTab(VCTKSREG).le.0 .and.
     +   CouTab(VCTKSCTD).le.0      ) GO TO 999 
C
C VCTRHL currently from REG (KASE=1) or CTDonly (KASE=2) ??
C *********************************************************
C
C  Check on: matching number of tracks
C            equality of _qovr,_qxdh,_zh
C
       KASE = 1
C
       if(NROW.ne.CouTab(VCTKSREG)) go to 52
C
        do 51 ip = 1,NROW
          Call FetTab(VCTRHL,  ID,ip)
          Call FetTab(VCTKSREG,ID,ip)
          if(VCTRHL_qovr.ne.VCTKSREG_R(1)) go to 52
          if(VCTRHL_qxdh.ne.VCTKSREG_R(2)) go to 52
          if(VCTRHL_zh  .ne.VCTKSREG_R(3)) go to 52
 51     continue

       GO TO 60
C
 52    KASE = 2
C
C  New event?
 60    Call FetTab(ZREVT,ID,1)
       New_event = (ZREVT_RunNr   .ne.Last_r .or.
     +              ZREVT_EvtNr(3).ne.Last_ev)
       Last_r = ZREVT_RunNr
       Last_ev= ZREVT_EvtNr(3)
C
C  Loop over all entries in VCTRHL and scale if not yet done:
C ***********************************************************
       Do 61 ip = 1,NROW
         Call FetTab(VCTRHL,ID,ip)
         if(KASE.eq.1) then
           Call FetTab(VCTKSREG,ID,ip)
           orig = VCTKSREG_R(4)
         else     
           Call FetTab(VCTKSCTD,ID,ip)
           orig = VCTKSCTD_R(4)
         endif
C
C Already done??
         if(.not.New_event .and. VCTRHL_pgevc.ne.orig) GO TO 999
C No, so scale:
C +-----------------------------------------+
         VCTRHL_pgevc = FACTOR*orig
C +-----------------------------------------+

         Call RepEnt(VCTRHL)

 61    Continue
C
       status = 0
C 
C ------------------- Finished --------------------------- 
 999   CONTINUE
C
       END