C   24/11/83 610291843  MEMBER NAME  RDDATE   (JADEGS)      FORTRAN
C
C----------------------------------------------------------------------
      SUBROUTINE RDDATE
C----------------------------------------------------------------------
C
C   AUTHOR    E. ELSEN    13/05/82 :  SET SMEARING DATE
C
C        MOD  J. OLSSON   23/08/83 :  CHANGED THE DATE
C        MOD  C. BOWDERY  19/10/83 :  CHANGED THE DATE AGAIN
C        MOD  C. BOWDERY  22/11/83 :  FORCE SMEARING DATE FOR MU EVENTS
C        MOD  C. BOWDERY   8/02/84 :  CADMIN MACRO NOW ON PATRECSR
C        MOD          17.8.1986    J.OLSSON
C        MOD 29.10.1986    J.OLSSON   RESTRICT MISMATCH PRINT
C
C   ROUTINE CALLED IN RDTRIG.
C   THIS ROUTINE CAN BE USED TO OVERWRITE THE DATE
C   IN THE BANK 'HEAD' BEFORE DETECTOR STATUS OF INPUT
C   IS ASSUMED.
C
C   THE SMEARING DATE IS GIVEN IN COMMON /TODAY/. IT IS OVERRIDDEN BY
C   THE PRESENCE OF A MUEV BANK; THE DETECTOR STATUS IS THEN FIXED BY
C   THE TRACKING DATE OF THE MUON FILTER, STORED AT END OF HEAD BANK.
C
C   THE /TODAY/ DATE IS ALSO CHECKED FOR VALIDITY WITH RESPECT TO THE
C   STATUS OF THE VERTEX CHAMBER;  IF THE FLAG LVTXC IN
C   COMMON /CVCEX/ IS TRUE AND A SMEARING DATE BEFORE 1984 IS REQUESTED,
C   OR VICE VERSA, A WARNING IS PRINTED OUT.
C
C
C----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C
#include "cadmin.for"
C
      COMMON /TODAY/ HDATE(6)
C
      LOGICAL  LVTXC
      COMMON / CVCEX  / LVTXC
C
      COMMON / BCS / IW(1)
C
      DIMENSION HW(1)
      EQUIVALENCE ( HW(1), IW(1) )
C
      DATA IERPRI /0/
C
C------------------  C O D E  -----------------------------------------
C
      NPHEAD = IW( IBLN('HEAD') )
      IF( NPHEAD .LE. 0 ) RETURN
C
C                            IS THIS A MUON MONTE CARLO EVENT,
C                            THAT IS, IS THERE A 'MUEV' BANK PRESENT?
C
      MUEV = IW( IBLN('MUEV') )
      IF( MUEV .LE. 0 ) GO TO 1
C
C                            YES, SO SET THE JETC SMEARING DATE TO BE
C                            THE SAME AS THE MUON TRACKING DATE
C                            AS RECORDED IN THE 'HEAD' BANK.
C
        HW(NPHEAD*2+6) = HW(NPHEAD*2+96)
        HW(NPHEAD*2+7) = HW(NPHEAD*2+97)
        HW(NPHEAD*2+8) = HW(NPHEAD*2+98)
C
        NFLAGS(1) = NFLAGS(1) + 1
        IF( NFLAGS(1) .GT.1) RETURN
        WRITE(6,3) (HW(NPHEAD*2+I),I=6,8)
   3    FORMAT(/' ****  MUON MONTE CARLO EVENT TYPE ENCOUNTERED.'/
     +          ' ****  RDDATE SET JETC SMEARING DATE TO ',3I8/
     +          ' ****  SO AS TO AGREE WITH THE MUON TRACKING DATE'/)
C
C CHECK VALIDITY OF THIS DATE, AS COMPARED WITH VTXC STATUS
C
        IF(IERPRI.GT.10) RETURN
C
        IF(LVTXC.AND.HW(NPHEAD*2+8).LT.1984) IERPRI = IERPRI + 1
        IF(LVTXC.AND.HW(NPHEAD*2+8).LT.1984) WRITE(6,33)
  33    FORMAT(/' # # #  MISMATCH:  DATA HAVE VERTEX CHAMBER GEOMETRY',
     + /,'        AND SMEARING DATE < 1984   # # # #')
C
        IF(.NOT.LVTXC.AND.HW(NPHEAD*2+8).GT.1984) IERPRI = IERPRI + 1
        IF(.NOT.LVTXC.AND.HW(NPHEAD*2+8).GT.1984) WRITE(6,34)
  34    FORMAT(/' # # # #  MISMATCH:  DATA HAVE NO VERTEX CHAMBER GEOMET
     +RY',/,'        AND SMEARING DATE > 1983   # # # #')
C
        RETURN
C
C                       NOT A MUON MC EVENT SO SET SMEARING DATE
C                       TO COMMON /TODAY/ VALUE. FIRST CHECK IF
C                       THERE IS AGREEMENT WITH VERTEX CHAMBER STATUS.
C
  1   CONTINUE
        IF(LVTXC.AND.HDATE(6).GE.1984) GO TO 5900
        IF(.NOT.LVTXC.AND.HDATE(6).LT.1984) GO TO 5900
C       IF(.NOT.LVTXC) HDATE(6) = 1982
C       IF(LVTXC) HDATE(6) = 1985
        NFLAGS(1) = NFLAGS(1) + 1
C       IF( NFLAGS(1) .GT.1) GO TO 5900
        IF(IERPRI.GT.10) GO TO 5900
C
        IF(.NOT.LVTXC) IERPRI = IERPRI + 1
        IF(.NOT.LVTXC) WRITE(6,34)
C
        IF(LVTXC) IERPRI = IERPRI + 1
        IF(LVTXC) WRITE(6,33)
C
C       WRITE(6,35) HDATE
C 35    FORMAT(/'  --->>  SMEARING DATE FORCED TO ',5I3,I5)
C
5900  CONTINUE
      HW(NPHEAD*2+6) = HDATE(4)
      HW(NPHEAD*2+7) = HDATE(5)
      HW(NPHEAD*2+8) = HDATE(6)
C
      IF(NFLAGS(1).EQ.1) WRITE(6,1022) HDATE(4),HDATE(5),HDATE(6)
1022  FORMAT(' RDDATE: SMEARING DATE IS ',I2,'/',I2,' - ',I4)
C
      RETURN
      END
