C   20/10/82 409271500  MEMBER NAME  KALIBR   (JADEGS)      FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE KALIBR
C-----------------------------------------------------------------------
C
C        HANDLES STANDARD JADE CALIBRATION DATA
C
C
C        TEMPORARY KLUGE TO PUT IN SOMEWHAT BETTER CALIBRATION DATA
C        IN THE CASE OF REAL DATA THAN THE MONTE CARLO VALUES. THE
C        "TWISTING ANGLE" IS LEFT AT 20 DEGREES FOR THE TIME BEING
C        BUT ITS SIGN IS REVERSED COMPARED TO THE MONTE CARLO CONVEN-
C        TION IN ORDER TO CONFORM TO THE DATA TAKEN SO FAR, FOR WHICH
C        THE MAGNETIC FIELD POINTS ALONG THE MINUS Z AXIS. THE TIMING-
C        BINS-TO-MILLIMETERS CONVERSION FACTORS ARE ALL SET TO 0.382
C        AND THE EFFECTIVE LENGTH OF THE WIRES TO 2792.9, BOTH VALUES
C        OBTAINED FROM MR. NOZAKI TODAY.
C                                      TUESDAY, MARCH 27, 1979
C                                      L.H. O'NEILL
C        ADDED: BKGAUS = -4.9          J.OLSSON 2.4.79
C        DIVIDED TIMDELS BY 64.        L.H. O'NEILL 11 JUNE, 1979.
C        UPDATED SETTING OF BKGAUS, CALL TO INPATR OUT
C                                      J.OLSSON 23.6.79
C
C        NEW VERSION SETS WIRE STAGGERING TO 200 MICRONS INSTEAD OF
C        150 AND INCREASES WIRE RADII BY 0.5 MM.
C
C                                      L.O'NEILL 02.08.79 14.50
C        BKGAUS IS TESTED UPON TO INSURE THAT IT IS NEGATIVE
C                                      J OLSSON 18.08.79
C        MANY CHANGES IN ALFA AND TZERO VALUES , NOZAKIS NEW CONSTANTS
C        INTRODUCED 14.9.80                 J.OLSSON
C        LORENTZ ANGLE VARIES WITH MAGNETC FIELD VALUE IF VARIATION
C        IF VARIATION > 1%                  P.STEFFEN 81/05/12
C        YEAR UPDATE FOR RUNS 7417-28       J.OLSSON 81/05/29
C        29 FEBRUARY UPDATE                 J.OLSSON 81/06/05
C     NEW 81 RUNS WITH YEAR 0 DISCOVERED, CORRECTED  J.OLSSON 81.06.22
C
C        T0 + LORENZ ANGLES FOR 1981              P. STEFFEN 81/10/09
C
C     NOZAKI POINTED OUT THAT THE STATEMENT GO TO 8 IS MISSING BETWEEN
C     1981 AUTUMN AND 1982  T0 SETTING    THIS LEADS TO 1982 CONSTANTS
C     BEING USED FOR 1981 AUTUMN DATA !!!!
C     CHANGED THIS EVENING,  12.3.1982     J.OLSSON
C
C     E-BEAM SET TO 17300 MEV FOR RUN 11790       P. STEFFEN 82/09/21
C
C
C     NEW TWANG, DRIVELS AND T0 ADDED FOR RUNS > 11036
C     OLD VERSION RETAINED AS KALIBR0 !!!!
C                                                G.F.PEARCE 18/05/82
C
C     RUNS > 10000 : YEAR FORCED TO 1982
C                                                P. STEFFEN 82/06/15
C
C
C        T0 FOR 1982 (CORRECTED)                 P. STEFFEN 82/06/21
C        EBEAM FOR 12804-12805                   J.OLSSON   82/12/08
C        BFIELD FOR RUNS 13651-13653          J.OLSSON   83/06/13
C        BEAM E FOR RUNS 13707-13714          J.OLSSON   83/06/14
C        BEAM E FOR RUNS 10666,11038-11052    J.OLSSON   83/08/08
C        BEAM E FOR RUNS 11104,11791          J.OLSSON   83/08/01
C        BEAM E FOR RUN  13826                J.OLSSON   83/08/05
C        BEAM E FOR RUN  16342                J.OLSSON   84/09/27
C
C        ADDED EXTERNAL JADEBD                C.BOWDERY  84/01/09
C
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
C                                       FORCE LOADING OF JADE BLOCK DATA
      EXTERNAL JADEBD
C
#include "cdata.for"
C                                       INITIALIZE POINTER
      DATA LBINIT /0/
C
C------------------  C O D E  ------------------------------------------
C
      IF(LBINIT.NE.0) GOTO 10
         IQHEAD=IBLN('HEAD')
   10 CONTINUE
C
C
      IHHEAD=IDATA(IQHEAD)*2
      NRUN=HDATA(IHHEAD+10)
C
C                            FIX YEAR SCREW UP.
C
         IYEAR = HDATA(IHHEAD+8)
         IF(NRUN.GE. 2570.AND.NRUN.LE.2802) HDATA(IHHEAD+8)=1980
         IF(NRUN.GT. 6000.AND. IYEAR.LT.1981) HDATA(IHHEAD+8)=1981
         IF(NRUN.GT.10000.AND. IYEAR.LT.1982) HDATA(IHHEAD+8)=1982
C
C                            FIX 29 FEBRUARY 1981 SCREW UP
C
         IF(HDATA(IHHEAD+8).EQ.1984) GO TO 5410
         IF(HDATA(IHHEAD+7).NE.2) GO TO 5410
         IF(HDATA(IHHEAD+6).EQ.29) HDATA(IHHEAD+7) = 3
         IF(HDATA(IHHEAD+6).EQ.29) HDATA(IHHEAD+6) = 1
C
C                            RESET MAGNETIC FIELD FOR PERIOD WHEN  READ
C                            OUT SET IT TO 0
C
5410     CONTINUE
         IF(NRUN.EQ.11908) HDATA(IHHEAD+30) = -4848
         IF(NRUN.GE.13651.AND.NRUN.LE.13653) HDATA(IHHEAD+30) = -4844
         IF(NRUN.LT.12255.OR.NRUN.GT.12270) GO TO 5411
         HDATA(IHHEAD+30) = -4847
C
C                            CORRECT BEAM ENERGIES FOR SELECTED RUNS
C
5411     CONTINUE
         IF(NRUN.LT.10000) GO TO 5408
         IF(NRUN.GT.11037.AND.NRUN.LT.11053) HDATA(IHHEAD+29) = 17243
         IF(NRUN.EQ.11104.OR.NRUN.EQ.10666) HDATA(IHHEAD+29) = 17300
         IF(NRUN.EQ.11790.OR.NRUN.EQ.11791) HDATA(IHHEAD+29) = 17300
         IF(NRUN.EQ.12804.OR.NRUN.EQ.12805) HDATA(IHHEAD+29) = 19120
         IF(NRUN.GE.13707.AND.NRUN.LE.13713) HDATA(IHHEAD+29) = 20725
         IF(NRUN.EQ.13714) HDATA(IHHEAD+29) = 20740
         IF(NRUN.EQ.13826) HDATA(IHHEAD+29) = 20795
         IF(NRUN.EQ.16342) HDATA(IHHEAD+29) = 23240
C
C                            PRINTOUT(WARNING) LOW MAG.FIELD
C
5408     IFIELD = HDATA(IHHEAD+30)
         IF(IABS(IFIELD).LT.100) WRITE(6,5407) NRUN,IFIELD
5407  FORMAT(' * KALIBR #### *   WARNING: RUN ',I6,' HAS MAGNETIC FIELD
     $ = ',I6,' GAUSS ')
C
C                            PRINTOUT(WARNING) LOW BEAM ENERGY
C
         IF(NRUN.LT.6000) GO TO 1201
         IBEAM = HDATA(IHHEAD+29)
         IF(IBEAM.LT.5000) WRITE(6,5404) NRUN,IBEAM
5404  FORMAT(' * KALIBR #### *   WARNING: RUN ',I6,' HAS BEAM ENERGY = '
     $,I6,' MEV ')
C
1201  CONTINUE
      CALL KLREAD
C
      CALL MUREG(0)
C
      RETURN
      END
