C$Procedure      CKGPAV ( C-kernel, get pointing and angular velocity )

      SUBROUTINE CKGPAV ( INST, SCLKDP, TOL, REF, CMAT, AV, CLKOUT,
     .                    FOUND )

C$ Abstract
C
C     Get pointing (attitude) and angular velocity for a specified
C     spacecraft clock time.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     CK
C     SCLK
C
C$ Keywords
C
C     POINTING
C
C$ Declarations

      IMPLICIT NONE
      INCLUDE               'frmtyp.inc'
      INCLUDE               'zzctr.inc'

      INTEGER               INST
      DOUBLE PRECISION      SCLKDP
      DOUBLE PRECISION      TOL
      CHARACTER*(*)         REF
      DOUBLE PRECISION      CMAT   ( 3, 3 )
      DOUBLE PRECISION      AV     ( 3    )
      DOUBLE PRECISION      CLKOUT
      LOGICAL               FOUND

C$ Brief_I/O
C
C     Variable  I/O  Description
C     --------  ---  --------------------------------------------------
C     INST       I   NAIF ID of instrument, spacecraft, or structure.
C     SCLKDP     I   Encoded spacecraft clock time.
C     TOL        I   Time tolerance.
C     REF        I   Reference frame.
C     CMAT       O   C-matrix pointing data.
C     AV         O   Angular velocity vector.
C     CLKOUT     O   Output encoded spacecraft clock time.
C     FOUND      O   True when requested pointing is available.
C
C$ Detailed_Input
C
C     INST       is the NAIF integer ID for the instrument, spacecraft,
C                or other structure for which pointing and angular
C                velocity are requested. For brevity we will refer to
C                this object as the "instrument," and the frame fixed
C                to this object as the "instrument frame" or
C                "instrument-fixed" frame.
C
C     SCLKDP     is the encoded spacecraft clock time for which
C                pointing and angular velocity are requested.
C
C                The SPICELIB routines SCENCD and SCE2C respectively
C                convert spacecraft clock strings and ephemeris time to
C                encoded spacecraft clock.  The inverse conversions are
C                performed by SCDECD and SCT2E.
C
C     TOL        is a time tolerance in ticks, the units of encoded
C                spacecraft clock time.
C
C                The SPICELIB routine SCTIKS converts a spacecraft
C                clock tolerance duration from its character string
C                representation to ticks.  SCFMT performs the inverse
C                conversion.
C
C                The C-matrix - angular velocity vector pair returned by
C                CKGPAV is the one whose time tag is closest to SCLKDP
C                and within TOL units of SCLKDP.  (More in Particulars,
C                below.)
C
C                In general, because using a non-zero tolerance
C                affects selection of the segment from which the
C                data is obtained, users are strongly discouraged
C                from using a non-zero tolerance when reading CKs
C                with continuous data. Using a non-zero tolerance
C                should be reserved exclusively to reading CKs with
C                discrete data because in practice obtaining data
C                from such CKs using a zero tolerance is often not
C                possible due to time round off.
C
C     REF        is the desired reference frame for the returned
C                pointing and angular velocity.  The returned C-matrix
C                CMAT gives the orientation of the instrument
C                designated by INST relative to the frame designated by
C                REF.  When a vector specified relative to frame REF is
C                left-multiplied by CMAT, the vector is rotated to the
C                frame associated with INST. The returned angular
C                velocity vector AV expresses the angular velocity of
C                the instrument designated by INST relative to the
C                frame designated by REF.  See the discussion of CMAT
C                and AV below for details.
C
C                Consult the SPICE document "Frames" for a discussion
C                of supported reference frames.
C
C$ Detailed_Output
C
C     CMAT       is a rotation matrix that transforms the components of
C                a vector expressed in the reference frame specified by
C                REF to components expressed in the frame tied to the
C                instrument, spacecraft, or other structure at time
C                CLKOUT (see below).
C
C                Thus, if a vector v has components x,y,z in the REF
C                reference frame, then v has components x',y',z' in the
C                instrument fixed frame at time CLKOUT:
C
C                     [ x' ]     [          ] [ x ]
C                     | y' |  =  |   CMAT   | | y |
C                     [ z' ]     [          ] [ z ]
C
C                If you know x', y', z', use the transpose of the
C                C-matrix to determine x, y, z as follows:
C
C                     [ x ]      [          ]T    [ x' ]
C                     | y |  =   |   CMAT   |     | y' |
C                     [ z ]      [          ]     [ z' ]
C                              (Transpose of CMAT)
C
C     AV         is the angular velocity vector. This is the axis about
C                which the reference frame tied to the instrument is
C                rotating in the right-handed sense at time CLKOUT. The
C                magnitude of AV is the magnitude of the instantaneous
C                velocity of the rotation, in radians per second.  AV
C                is expressed relative to the frame designated by REF.
C
C     CLKOUT     is the encoded spacecraft clock time associated with
C                the returned C-matrix and the returned angular
C                velocity vector. This value may differ from the
C                requested time, but never by more than the input
C                tolerance TOL.
C
C                The particulars section below describes the search
C                algorithm used by CKGPAV to satisfy a pointing
C                request.  This algorithm determines the pointing
C                instance (and therefore the associated time value)
C                that is returned.
C
C     FOUND      is true if a record was found to satisfy the pointing
C                request.  FOUND will be false otherwise.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     1)  If a C-kernel file has not been loaded using FURNSH prior to
C         a call to this routine, an error is signaled by a routine in
C         the call tree of this routine.
C
C     2)  If TOL is negative, found is set to .FALSE.
C
C     3)  If REF is not a supported reference frame, an error is
C         signaled by a routine in the call tree of this routine and
C         FOUND is set to .FALSE.
C
C$ Files
C
C     CKGPAV searches through files loaded by FURNSH to locate a
C     segment that can satisfy the request for pointing and angular
C     velocity for instrument INST at time SCLKDP.  You must load a
C     C-kernel file using FURNSH prior to calling this routine.
C
C$ Particulars
C
C     How the tolerance argument is used
C     ==================================
C
C
C     Reading a type 1 CK segment (discrete pointing instances)
C     ---------------------------------------------------------
C
C     In the diagram below
C
C        - "0" is used to represent discrete pointing instances
C          (quaternions, angular velocity vectors, and associated
C          time tags).
C
C        - "( )" are used to represent the end points of the time
C          interval covered by a segment in a CK file.
C
C        - SCLKDP is the time at which you requested pointing.
C          The location of SCLKDP relative to the time tags of the
C          pointing instances is indicated by the "+" sign.
C
C        - TOL is the time tolerance specified in the pointing
C          request.  The square brackets "[ ]" represent the
C          endpoints of the time interval
C
C             SCLKDP-TOL : SCLKDP+TOL
C
C        - The quaternions occurring in the segment need not be
C          evenly spaced in time.
C
C
C     Case 1:  pointing is available
C     ------------------------------
C
C                              SCLKDP
C                                   \   TOL
C                                    | /
C                                    |/\
C     Your request                [--+--]
C                                 .  .  .
C     Segment      (0-----0--0--0--0--0--0---0--0------------0--0--0--0)
C                                     ^
C                                     |
C                         CKGPAV returns this instance.
C
C
C     Case 2:  pointing is not available
C     ----------------------------------
C
C                                                   SCLKDP
C                                                      \   TOL
C                                                       | /
C                                                       |/\
C     Your request                                   [--+--]
C                                                    .  .  .
C     Segment      (0-----0--0--0--0--0--0---0--0--0---------0--0--0--0)
C
C
C                         CKGPAV returns no pointing; the output
C                         FOUND flag is set to .FALSE.
C
C
C
C     Reading a type 2, 3, 4, or 5 CK segment (continuous pointing)
C     -------------------------------------------------------------
C
C     In the diagrams below
C
C        - "==" is used to represent periods of continuous pointing.
C
C        - "--" is used to represent gaps in the pointing coverage.
C
C        - "( )" are used to represent the end points of the time
C          interval covered by a segment in a CK file.
C
C        - SCLKDP is the time at which you requested pointing.
C          The location of SCLKDP relative to the time tags of the
C          pointing instances is indicated by the "+" sign.
C
C        - TOL is the time tolerance specified in the pointing
C          request.  The square brackets "[ ]" represent the
C          endpoints of the time interval
C
C             SCLKDP-TOL : SCLKDP+TOL
C
C        - The quaternions occurring in the periods of continuous
C          pointing need not be evenly spaced in time.
C
C
C     Case 1:  pointing is available at the request time
C     --------------------------------------------------
C
C                             SCLKDP
C                                   \   TOL
C                                    | /
C                                    |/\
C     Your request                [--+--]
C                                 .  .  .
C                                 .  .  .
C                                 .  .  .
C     Segment            (==---===========---=======----------===--)
C                                    ^
C                                    |
C
C                   The request time lies within an interval where
C                   continuous pointing is available. CKGPAV returns
C                   pointing at the requested epoch.
C
C
C     Case 2:  pointing is available "near" the request time
C     ------------------------------------------------------
C
C                                    SCLKDP
C                                          \   TOL
C                                           | /
C                                           |/\
C     Your request                       [--+--]
C                                        .  .  .
C     Segment            (==---===========----=======---------===--)
C                                             ^
C                                             |
C
C                   The request time lies in a gap:  an interval where
C                   continuous pointing is *not* available.  CKGPAV
C                   returns pointing for the epoch closest to the
C                   request time SCLKDP.
C
C
C     Case 3:  pointing is not available
C     ----------------------------------
C
C                                                 SCLKDP
C                                                       \   TOL
C                                                        | /
C                                                        |/\
C     Your request                                    [--+--]
C                                                     .  .  .
C     Segment            (==---===========----=======---------===--)
C
C                         CKGPAV returns no pointing; the output
C                         FOUND flag is set to .FALSE.
C
C
C
C     Tolerance and segment priority
C     ==============================
C
C     CKGPAV searches through loaded C-kernels to satisfy a pointing
C     request. Last-loaded files are searched first. Individual files
C     are searched in backwards order, so that between competing
C     segments (segments containing data for the same object, for
C     overlapping time ranges), the one closest to the end of the file
C     has highest priority. CKGPAV considers only those segments that
C     contain both pointing and angular velocity data, as indicated by
C     the segment descriptor.
C
C     The search ends when a segment is found that can provide pointing
C     and angular velocity for the specified instrument at a time
C     falling within the specified tolerance on either side of the
C     request time. Within that segment, the instance closest to the
C     input time is located and returned.
C
C     The following four cases illustrate this search procedure.
C     Segments A and B are in the same file, with segment A located
C     further towards the end of the file than segment B. Both segments
C     A and B contain discrete pointing data, indicated by the number
C     0.
C
C
C     Case 1:  Pointing is available in the first segment searched.
C              Because segment A has the highest priority and can
C              satisfy the request, segment B is not searched.
C
C
C                                  SCLKDP
C                                        \  TOL
C                                         | /
C                                         |/\
C     Your request                     [--+--]
C                                      .  .  .
C     Segment A          (0-----------------0--------0--0-----0)
C                                           ^
C                                           |
C                                           |
C                               CKGPAV returns this instance
C
C     Segment B     (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0)
C
C
C
C     Case 2:  Pointing is not available in the first segment searched.
C              Because segment A cannot satisfy the request, segment B
C              is searched.
C
C
C                             SCLKDP
C                                  \   TOL
C                                   | /
C                                   |/\
C     Your request               [--+--]
C                                .  .  .
C     Segment A          (0-----------------0--------0--0-----0)
C                                .  .  .
C     Segment B     (0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0--0)
C                                   ^
C                                   |
C                       CKGPAV returns this instance
C
C
C     Segments that contain continuous pointing data are searched in
C     the same manner as segments containing discrete pointing data.
C     For request times that fall within the bounds of continuous
C     intervals, CKGPAV will return pointing at the request time. When
C     the request time does not fall within an interval, then a time at
C     an endpoint of an interval may be returned if it is the closest
C     time in the segment to the user request time and is also within
C     the tolerance.
C
C     In the following examples, segment A is located further towards
C     the end of the file than segment C. Segment A contains discrete
C     pointing data and segment C contains continuous data, indicated
C     by the "=" character.
C
C
C     Case 3:  Pointing is not available in the first segment searched.
C              Because segment A cannot satisfy the request, segment C
C              is searched.
C
C                             SCLKDP
C                                   \  TOL
C                                    | /
C                                    |/\
C     Your request                [--+--]
C                                 .  .  .
C                                 .  .  .
C     Segment A          (0-----------------0--------0--0-----0)
C                                 .  .  .
C                                 .  .  .
C     Segment C          (---=============-----====--------==--)
C                                    ^
C                                    |
C                                    |
C                         CKGPAV returns this instance
C
C
C     In the next case, assume that the order of segments A and C in the
C     file is reversed:  A is now closer to the front, so data from
C     segment C are considered first.
C
C
C     Case 4:  Pointing is available in the first segment searched.
C              Because segment C has the highest priority and can
C              satisfy the request, segment A is not searched.
C
C                                             SCLKDP
C                                            /
C                                           |  TOL
C                                           | /
C                                           |/\
C     Your request                       [--+--]
C                                        .  .  .
C                                        .  .  .
C     Segment C          (---=============-----====--------==--)
C                                             ^
C                                             |
C                                CKGPAV returns this instance
C
C     Segment A          (0-----------------0--------0--0-----0)
C                                           ^
C                                           |
C                                     "Best" answer
C
C
C     The next case illustrates an unfortunate side effect of using
C     a non-zero tolerance when reading multi-segment CKs with
C     continuous data. In all cases when the look-up interval
C     formed using tolerance overlaps a segment boundary and
C     the request time falls within the coverage of the lower
C     priority segment, the data at the end of the higher priority
C     segment will be picked instead of the data from the lower
C     priority segment.
C
C
C     Case 5:  Pointing is available in the first segment searched.
C              Because segment C has the highest priority and can
C              satisfy the request, segment A is not searched.
C
C                                             SCLKDP
C                                            /
C                                           |  TOL
C                                           | /
C                                           |/\
C     Your request                       [--+--]
C                                        .  .  .
C                                        .  .  .
C     Segment C                                (===============)
C                                              ^
C                                              |
C                                CKGPAV returns this instance
C
C     Segment A          (=====================)
C                                           ^
C                                           |
C                                     "Best" answer
C
C$ Examples
C
C
C     Suppose you have two C-kernel files containing data for the
C     Voyager 2 narrow angle camera.  One file contains predict values,
C     and the other contains corrected pointing for a selected group
C     of images, that is, for a subset of images from the first file.
C
C     The following example program uses CKGPAV to get C-matrices and
C     associated angular velocity vectors for a set of images whose
C     SCLK counts (un-encoded character string versions) are contained
C     in the array SCLKCH.
C
C     If available, the program will get the corrected pointing values.
C     Otherwise, predict values will be used.
C
C     For each C-matrix, a unit  pointing vector is constructed
C     and printed along with the angular velocity vector.
C
C     Note: if the C-kernels of interest do not contain angular
C     velocity data, then the SPICELIB routine CKGP should be used to
C     read the pointing data.  An example program in the header of the
C     SPICELIB routine CKGP demonstrates this.
C
C
C
C     C
C     C     Constants for this program.
C     C
C     C     -- The code for the Voyager 2 spacecraft clock is -32
C     C
C     C     -- The code for the narrow angle camera on the Voyager 2
C     C        spacecraft is -32001.
C     C
C     C    --  Spacecraft clock times for successive Voyager images
C     C        always differ by more than 0:0:400.  This is an
C     C        acceptable tolerance, and must be converted to "ticks"
C     C        (units of encoded SCLK) for input to CKGPAV.
C     C
C     C     -- The reference frame we want is FK4.
C     C
C     C     -- The narrow angle camera boresight defines the third
C     C        axis of the instrument-fixed coordinate system.
C     C        Therefore, the vector ( 0, 0, 1 ) represents
C     C        the boresight direction in the camera-fixed frame.
C     C
C           IMPLICIT NONE
C
C           INTEGER               FILEN
C           PARAMETER           ( FILEN  = 255 )
C
C           INTEGER               NPICS
C           PARAMETER           ( NPICS  = 2 )
C
C           INTEGER               TIMLEN
C           PARAMETER           ( TIMLEN = 30 )
C
C           INTEGER               REFLEN
C           PARAMETER           ( REFLEN = 32 )
C
C           CHARACTER*(TIMLEN)    CLKCH
C           CHARACTER*(FILEN)     CKPRED
C           CHARACTER*(FILEN)     CKCORR
C           CHARACTER*(REFLEN)    REF
C           CHARACTER*(FILEN)     SCLK
C           CHARACTER*(TIMLEN)    SCLKCH ( NPICS )
C           CHARACTER*(TIMLEN)    TOLVGR
C
C           DOUBLE PRECISION      AV     ( 3 )
C           DOUBLE PRECISION      CLKOUT
C           DOUBLE PRECISION      CMAT   ( 3, 3 )
C           DOUBLE PRECISION      SCLKDP
C           DOUBLE PRECISION      TOLTIK
C           DOUBLE PRECISION      VCFIX  ( 3 )
C           DOUBLE PRECISION      VINERT ( 3 )
C
C           INTEGER               SC
C           INTEGER               I
C           INTEGER               INST
C
C           LOGICAL               FOUND
C
C           CKPRED     = 'voyager2_predict.bc'
C           CKCORR     = 'voyager2_corrected.bc'
C           SCLK       = 'voyager2_sclk.tsc'
C           SC         = -32
C           INST       = -32001
C           SCLKCH(1)  = '4/08966:30:768'
C           SCLKCH(2)  = '4/08970:58:768'
C           TOLVGR     = '0:0:400'
C           REF        = 'FK4'
C           VCFIX( 1 ) =  0.D0
C           VCFIX( 2 ) =  0.D0
C           VCFIX( 3 ) =  1.D0
C
C     C
C     C     Loading the files in this order ensures that the
C     C     corrected file will get searched first.
C     C
C           CALL FURNSH ( CKPRED )
C           CALL FURNSH ( CKCORR )
C
C     C
C     C     Need to load a Voyager 2 SCLK kernel to convert from
C     C     clock strings to ticks.
C     C
C           CALL FURNSH ( SCLK )
C
C     C
C     C     Convert tolerance from VGR formatted character string
C     C     SCLK to ticks which are units of encoded SCLK.
C     C
C           CALL SCTIKS ( SC, TOLVGR, TOLTIK )
C
C
C           DO I = 1, NPICS
C     C
C     C        CKGPAV requires encoded spacecraft clock.
C     C
C              CALL SCENCD ( SC, SCLKCH( I ), SCLKDP )
C
C              CALL CKGPAV ( INST,   SCLKDP, TOLTIK, REF, CMAT, AV,
C          .                 CLKOUT, FOUND                        )
C
C              IF ( FOUND ) THEN
C
C     C
C     C           Use the transpose of the C-matrix to transform the
C     C           boresight vector from camera-fixed to reference
C     C           coordinates.
C     C
C                 CALL MTXV   ( CMAT, VCFIX,  VINERT )
C                 CALL SCDECD ( SC,   CLKOUT, CLKCH  )
C
C                 WRITE (*,*) 'VGR 2 SCLK Time:         ', CLKCH
C                 WRITE (*,*) 'VGR 2 NA ISS boresight '
C          .      //          'pointing vector: ',         VINERT
C                 WRITE (*,*) 'Angular velocity vector: ', AV
C
C              ELSE
C
C                 WRITE (*,*) 'Pointing not found for time ', SCLKCH(I)
C
C              END IF
C
C           END DO
C
C           END
C
C
C$ Restrictions
C
C     Only loaded C-kernel segments containing both pointing and
C     angular velocity data will be searched by this reader.  Segments
C     containing only pointing data will be skipped over.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     C.H. Acton     (JPL)
C     N.J. Bachman   (JPL)
C     W.L. Taber     (JPL)
C     J.M. Lynch     (JPL)
C     B.V. Semenov   (JPL)
C     M.J. Spencer   (JPL)
C     R.E. Thurman   (JPL)
C     I.M. Underwood (JPL)
C
C$ Version
C
C-    SPICELIB Version 5.3.0, 23-SEP-2013 (BVS)
C
C        Updated to save the input frame name and POOL state counter
C        and to do frame name-ID conversion only if the counter has
C        changed.
C
C-    SPICELIB Version 5.2.1, 03-JUN-2010 (BVS)
C
C        Header update: description of the tolerance and Particulars
C        section were expanded to address some problems arising from
C        using a non-zero tolerance.
C
C-    SPICELIB Version 5.2.0, 25-AUG-2005 (NJB)
C
C        Updated to remove non-standard use of duplicate arguments
C        in MTXV, MXM and VADD calls.
C
C-    SPICELIB Version 5.1.2, 29-JAN-2004 (NJB)
C
C        Header update:  descriptions of input arguments REF and
C        AV were expanded.
C
C-    SPICELIB Version 5.1.1, 27-JUL-2003 (CHA) (NJB)
C
C        Various header corrections were made.
C
C-    SPICELIB Version 5.1.0, 23-FEB-1999 (WLT)
C
C        The previous editions of this routine did not properly handle
C        the case when TOL was negative.  The routine now returns a
C        value of .FALSE. for FOUND as is advertised above.
C
C-    SPICELIB Version 5.0.0, 28-JUL-1997 (WLT)
C
C        The previous routine incorrectly computed the angular
C        velocity of the transformation from the request frame
C        to the platform frame of the C-matrix for non-inertial
C        reference frames.
C
C-    SPICELIB Version 4.0.0, 19-SEP-1995 (WLT)
C
C        The routine was upgraded so that the reference frame may
C        be non-inertial.
C
C-    SPICELIB Version 3.0.0, 5-OCT-1994 (WLT)
C
C        The previous versions all computed an incorrect
C        value for the angular velocity if the frame specified by
C        REF was different from the reference frame of the segment
C        from which the angular velocity was extracted. This has
C        now been corrected.
C
C-    SPICELIB Version 2.0.1, 10-MAR-1992 (WLT)
C
C        Comment section for permuted index source lines was added
C        following the header.
C
C-    SPICELIB Version 2.0.0, 30-AUG-1991 (JML)
C
C        1) The Particulars section was updated to show how the
C           search algorithm processes segments with continuous
C           pointing data.
C
C        2) It was specified that the angular velocity vector
C           gives the right-handed axis about which the instrument
C           frame rotates.
C
C        3) The example program now loads an SCLK kernel.
C
C        4) FAILED is checked after the call to IRFROT to handle the
C           case where the reference frame is invalid and the error
C           handling is not set to abort.
C
C        5) FAILED is checked in the DO WHILE loop to handle the case
C           where an error is detected by a SPICELIB routine inside the
C           loop and the error handling is not set to abort.
C
C-    SPICELIB Version 1.1.0, 02-NOV-1990 (JML)
C
C        1) The variable NEEDAV is no longer being saved.
C        2) In the example program, the calling sequences
C           for SCENCD and CKGPAV were corrected.
C        3) The restriction that a C-kernel file must be loaded
C           was explicitly stated.
C
C-    SPICELIB Version 1.0.0, 07-SEP-1990 (RET) (IMU)
C
C-&

C$ Index_Entries
C
C     get ck pointing and angular velocity
C
C-&

C$ Revisions
C
C-    SPICELIB Version 5.2.0, 25-AUG-2005 (NJB)
C
C        Updated to remove non-standard use of duplicate arguments
C        in MTXV, MXM and VADD calls.
C
C-    SPICELIB Version 4.1.0, 20-DEC-1995 (WLT)
C
C        A call to FRINFO did not have enough arguments and
C        went undetected until Howard Taylor of ACT.  Many
C        thanks go out to Howard for tracking down this error.
C
C-    SPICELIB Version 4.0.0, 19-SEP-1995 (WLT)
C
C        The routine was upgraded so that the reference frame may
C        be non-inertial.
C
C-    SPICELIB Version 3.0.0, 5-OCT-1994 (WLT)
C
C        The previous versions all computed an incorrect
C        value for the angular velocity if the frame specified by
C        REF was different from the reference frame of the segment
C        from which the angular velocity was extracted. This has
C        now been corrected.
C
C        Previously we were multiplying by the inverse of the
C        rotation that transforms frames.
C
C-    SPICELIB Version 2.0.0, 30-AUG-1991 (JML)
C
C        1) The Particulars section was updated to show how the
C           search algorithm processes segments with continuous
C           pointing data.
C
C        2) It was specified that the angular velocity vector
C           gives the right-handed axis about which the instrument
C           frame rotates.
C
C        3) The example program now loads an SCLK kernel.
C
C        4) FAILED is checked after the call to IRFROT to handle the
C           case where the reference frame is invalid and the error
C           handling is not set to abort.
C
C        5) FAILED is checked in the DO WHILE loop to handle the case
C           where an error is detected by a SPICELIB routine inside the
C           loop and the error handling is not set to abort.
C
C-    SPICELIB Version 1.1.0, 02-NOV-1990 (JML)
C
C        1) The variable NEEDAV is no longer being saved.
C        2) In the example program, the calling sequences
C           for SCENCD and CKGPAV were corrected.
C        3) The restriction that a C-kernel file must be loaded
C           was explicitly stated.
C
C-    Beta Version 1.1.0, 30-AUG-1990 (MJS)
C
C        The following changes were made as a result of the
C        NAIF CK Code and Documentation Review:
C
C        1) The variable SCLK was changed to SCLKDP.
C        2) The variable INSTR was changed to INST.
C        3) The variable IDENT was changed to SEGID.
C        4) The declarations for the parameters NDC, NIC, NC, and
C           IDLEN were moved from the "Declarations" section of the
C           header to the "Local parameters" section of the code below
C           the header. These parameters are not meant to modified by
C           users.
C        5) The header was updated to reflect the changes.
C
C-    Beta Version 1.0.0, 04-JUN-1990 (RET) (IMU)
C
C-&

C
C     SPICELIB functions
C
      LOGICAL               RETURN

      LOGICAL               FAILED

C
C     Local parameters
C
C        NDC        is the number of double precision components in an
C                   unpacked C-kernel segment descriptor.
C
C        NIC        is the number of integer components in an unpacked
C                   C-kernel segment descriptor.
C
C        NC         is the number of components in a packed C-kernel
C                   descriptor.  All DAF summaries have this formulaic
C                   relationship between the number of its integer and
C                   double precision components and the number of packed
C                   components.
C
C        IDLEN      is the length of the C-kernel segment identifier.
C                   All DAF names have this formulaic relationship
C                   between the number of summary components and
C                   the length of the name (You will notice that
C                   a name and a summary have the same length in bytes.)
C

      INTEGER               NDC
      PARAMETER           ( NDC = 2 )

      INTEGER               NIC
      PARAMETER           ( NIC = 6 )

      INTEGER               NC
      PARAMETER           ( NC = NDC + ( NIC + 1 )/2 )

      INTEGER               IDLEN
      PARAMETER           ( IDLEN = NC * 8 )

C
C     Saved frame name length.
C
      INTEGER               FRNMLN
      PARAMETER           ( FRNMLN = 32 )

C
C     Local variables
C
      CHARACTER*(IDLEN)     SEGID

      DOUBLE PRECISION      DCD      ( NDC  )
      DOUBLE PRECISION      DESCR    ( NC   )
      DOUBLE PRECISION      ET
      DOUBLE PRECISION      OMEGA    ( 3    )
      DOUBLE PRECISION      ROT      ( 3, 3 )
      DOUBLE PRECISION      TMPMAT   ( 3, 3 )
      DOUBLE PRECISION      TMPV     ( 3 )
      DOUBLE PRECISION      XFORM    ( 6, 6 )

      INTEGER               CENTER
      INTEGER               HANDLE
      INTEGER               ICD      ( NIC  )
      INTEGER               REFREQ
      INTEGER               REFSEG
      INTEGER               SCLK
      INTEGER               TYPE1
      INTEGER               TYPE2
      INTEGER               TYPEID

      LOGICAL               NEEDAV
      LOGICAL               PFND
      LOGICAL               SFND
      LOGICAL               GOTIT

C
C     Saved frame name/ID item declarations.
C
      INTEGER               SVCTR1 ( CTRSIZ )
      CHARACTER*(FRNMLN)    SVREF
      INTEGER               SVREFR

      LOGICAL               FIRST

C
C     Saved frame name/ID items.
C
      SAVE                  SVCTR1
      SAVE                  SVREF
      SAVE                  SVREFR

      SAVE                  FIRST

C
C     Initial values.
C
      DATA                  FIRST   / .TRUE. /

C
C     Standard SPICE error handling.
C
      IF ( RETURN () ) THEN
         RETURN
      ELSE
         CALL CHKIN ( 'CKGPAV' )
      END IF

C
C     Initialization.
C
      IF ( FIRST ) THEN

C
C        Initialize counter.
C
         CALL ZZCTRUIN( SVCTR1 )

         FIRST = .FALSE.

      END IF

C
C     Need angular velocity data.
C     Assume the segment won't be found until it really is.
C
      NEEDAV = .TRUE.
      FOUND  = .FALSE.

C
C     If the tolerance is less than zero, we go no further.
C
      IF ( TOL .LT. 0.0D0 ) THEN
         CALL CHKOUT ( 'CKGPAV' )
         RETURN
      END IF

C
C     Begin a search for this instrument and time, and get the first
C     applicable segment.
C
      CALL CKBSS ( INST,   SCLKDP, TOL,   NEEDAV )
      CALL CKSNS ( HANDLE, DESCR,  SEGID, SFND   )

C
C     Keep trying candidate segments until a segment can produce a
C     pointing instance within the specified time tolerance of the
C     input time.
C
C     Check FAILED to prevent an infinite loop if an error is detected
C     by a SPICELIB routine and the error handling is not set to abort.
C
      DO WHILE ( ( SFND ) .AND. ( .NOT. FAILED () ) )

         CALL CKPFS ( HANDLE, DESCR, SCLKDP, TOL, NEEDAV,
     .                CMAT,   AV,    CLKOUT, PFND          )

         IF ( PFND ) THEN
C
C           Found one. If the data aren't already referenced to the
C           requested frame, rotate them.
C
            CALL DAFUS  ( DESCR, NDC, NIC, DCD, ICD )
            REFSEG = ICD( 2 )
C
C           Look up the id code for the requested reference frame.
C
            CALL ZZNAMFRM ( SVCTR1, SVREF, SVREFR, REF, REFREQ )

            IF ( REFREQ .NE. REFSEG ) THEN
C
C              We may need to convert the output ticks CLKOUT to ET
C              so that we can get the needed state transformation
C              matrix.  This is the case if either of the frames
C              is non-inertial.
C
               CALL FRINFO ( REFREQ, CENTER, TYPE1, TYPEID, GOTIT )
               CALL FRINFO ( REFSEG, CENTER, TYPE2, TYPEID, GOTIT )

               IF (       TYPE1 .EQ. INERTL
     .              .AND. TYPE2 .EQ. INERTL ) THEN
C
C                 Any old value of ET will do in this case.  We'll
C                 use zero.
C
                  ET = 0.0D0

               ELSE
C
C                 Look up the spacecraft clock id to use to convert
C                 the output CLKOUT to ET.
C
                  CALL CKMETA ( INST, 'SCLK', SCLK )
                  CALL SCT2E  ( SCLK, CLKOUT, ET   )

               END IF
C
C              Get the transformation from the requested frame to
C              the segment frame at ET.
C
               CALL FRMCHG ( REFREQ, REFSEG, ET, XFORM )
C
C              If FRMCHG detects that the reference frame is invalid
C              then return from this routine with FOUND equal to false.
C
               IF ( FAILED () ) THEN
                  CALL CHKOUT ( 'CKGPAV' )
                  RETURN
               END IF
C
C              First transform the attitude information. Get the
C              rotation and angular velocity associated with the
C              transformation from request frame to segment frame.
C              Then convert CMAT so that it maps from request frame
C              to C-matrix frame.
C
               CALL XF2RAV ( XFORM,   ROT,  OMEGA  )
               CALL MXM    ( CMAT,    ROT,  TMPMAT )
               CALL MOVED  ( TMPMAT,  9,    CMAT   )
C
C              Now transform the angular velocity information.
C              Currently we have OMEGA (the angular velocity of
C              the transformation from REF frame to the base
C              frame of the C-matrix), and AV the angular velocity
C              of the transformation from the C-MATRIX reference
C              system to the platform of the C-matrix.
C
C              The angular velocity of the C-MATRIX relative to
C              requested frame is given by
C
C                            T
C                 OMEGA + ROT * AV
C
C              Here's why.
C
C              The transformation from the request frame to the frame
C              of the C-kernel looks like this:
C
C                     [                 ]
C                     [   ROT   :   0   ]
C                     [................ ]
C                     [  dROT   :       ]
C                     [  ----   : ROT   ]
C                     [    dt   :       ]
C
C              The transformation from the C-kernel reference frame to
C              the C-kernel platform frame looks like:
C
C
C                     [                 ]
C                     [  CMAT   :   0   ]
C                     [ ............... ]
C                     [  dCMAT  :       ]
C                     [  ----   : CMAT  ]
C                     [    dt   :       ]
C
C
C              The transformation from the request frame to the platform
C              frame is the product shown below
C
C
C               [                 ][                 ]
C               [  CMAT   :   0   ][   ROT   :   0   ]
C               [ ............... ][................ ]
C               [  dCMAT  :       ][  dROT   :       ]
C               [  ----   : CMAT  ][  ----   : ROT   ]
C               [    dt   :       ][    dt   :       ]
C
C
C                     [                            :             ]
C                     [  CMAT * ROT                :   0         ]
C              =      [ ........................................ ]
C                     [  dCMAT                dROT :             ]
C                     [  ----  * ROT + CMAT * ---- : CMAT * ROT  ]
C                     [    dt                  dt  :             ]
C
C
C              In general, the angular velocity matrix of a
C              transformation R is given by
C
C                   T
C                 dR
C                 --  * R
C                 dt
C
C              Substituting the appropriate components of the matrix
C              in for R we have:
C
C                                  T        T
C              OMEGA         =  ROT  * dCMAT  * CMAT * ROT
C                   CMAT*ROT           -----
C                                        dt
C
C                                        T
C                                    dROT       T
C                               +    ---- * CMAT  * CMAT * ROT
C                                     dt
C
C
C                                  T
C                            =  ROT  * OMEGA      * ROT   + OMEGA
C                                            CMAT                ROT
C
C
C              Consider the first term of the final expression. If we
C              let "x" stand for the cross product operation, then by
C              definition for any vector V:
C
C
C                  T
C               ROT  * OMEGA     * ROT  * V
C                           CMAT
C
C
C                             T
C                        = ROT  * (AV     x  ROT*V )
C                                    CMAT
C
C                          (since rotations distribute across cross
C                           products)
C
C                              T                  T
C                        = (ROT * AV    ) x  ( ROT * ROT*V )
C                                   CMAT
C
C
C                              T
C                        = (ROT * AV    ) x  V
C                                   CMAT
C
C              Thus OMEGA         is the matrix form of the cross
C                        CMAT*ROT
C
C                                      T
C              product operation {( ROT *AV    )   +  AV   } x  .
C                                          CMAT         ROT
C
C
               CALL MTXV ( ROT,    AV,    TMPV )
               CALL VADD ( OMEGA,  TMPV,  AV   )

            END IF

            FOUND = .TRUE.

            CALL CHKOUT ( 'CKGPAV' )
            RETURN

         END IF

         CALL CKSNS ( HANDLE, DESCR, SEGID, SFND )

      END DO

      CALL CHKOUT ( 'CKGPAV' )
      RETURN
      END


C$Procedure ZZCKCV06 ( Private --- C-kernel segment coverage, type 06 )

      SUBROUTINE ZZCKCV06 ( HANDLE, ARRBEG, ARREND, SCLKID,
     .                      DC,     TOL,    TIMSYS, SCHEDL )

C$ Abstract
C
C     SPICE Private routine intended solely for the support of SPICE
C     routines.Users should not call this routine directly due
C     to the volatile nature of this routine.
C
C     Determine the "window" of coverage of a type 06 C-kernel segment.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     CK
C     DAF
C
C$ Keywords
C
C     CK
C     UTILITY
C     PRIVATE
C
C$ Declarations

      IMPLICIT NONE

      INCLUDE              'ck06.inc'

      INTEGER               LBCELL
      PARAMETER           ( LBCELL = -5 )

      INTEGER               HANDLE
      INTEGER               ARRBEG
      INTEGER               ARREND
      INTEGER               SCLKID
      DOUBLE PRECISION      DC     ( 2 )
      DOUBLE PRECISION      TOL
      CHARACTER*(*)         TIMSYS
      DOUBLE PRECISION      SCHEDL ( LBCELL:* )

C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     HANDLE     I   Handle of a C-kernel open for read access.
C     ARRBEG     I   Beginning DAF address.
C     ARREND     I   Ending DAF address.
C     SCLKID     I   ID of SCLK associated with segment.
C     DC         I   D.p. component of CK segment descriptor.
C     TOL        I   Tolerance in ticks.
C     TIMSYS     I   Time system used to represent coverage.
C     SCHEDL    I/O  An initialized window/schedule of interval
C
C$ Detailed_Input
C
C     HANDLE     is the handle of some DAF that is open for reading.
C
C     ARRBEG     is the beginning address of the type 06 segment
C                to be examined.
C
C     ARREND     is the ending address of the type 06 segment.
C
C     SCLKID     is the ID code of the spacecraft clock associated with
C                the object for which the segment contains pointing.
C                This is the ID code used by the SCLK conversion
C                routines.
C
C     DC         is the double precision component of the descriptor of
C                the CK segment. The components are the segment start
C                and stop times.
C
C                Each mini-segment interval is replaced with its
C                intersection with the segment coverage interval
C
C                   [ DC(1), DC(2) ]
C
C                before being expanded by TOL. Mini-segment intervals
C                that don't intersect the segment coverage interval are
C                discarded, even if after expansion by TOL they would
C                have non-empty intersection with the segment coverage
C                interval.
C
C     TOL        is a tolerance value expressed in ticks of the
C                spacecraft clock associated with the segment. After
C                truncation by the segment coverage interval, and
C                before insertion into the coverage window, each
C                non-empty truncated mini-segment interval is expanded
C                by TOL:  the left endpoint of each interval is reduced
C                by TOL and the right endpoint is increased by TOL.
C                Any intervals that overlap as a result of the
C                expansion are merged.
C
C                The coverage window returned when TOL > 0 indicates
C                the coverage provided by the file to the CK readers
C                CKGPAV and CKGP when that value of TOL is passed to
C                them as an input.
C
C
C     TIMSYS     is a string indicating the time system used in the
C                output coverage window.TIMSYS may have the values:
C
C                   'SCLK'    Elements of SCHEDL are expressed in
C                             encoded SCLK ("ticks"), where the clock
C                             is associated with the object designated
C                             by IDCODE.
C
C                   'TDB'     Elements of SCHEDL are expressed as
C                             seconds past J2000 TDB.
C
C                TIMSYS must be consistent with the system used for
C                the contents of SCHEDL on input, if any.
C
C
C     SCHEDL     is a schedule (window) of intervals, to which the
C                intervals of coverage for this segment will be added.
C
C$ Detailed_Output
C
C     SCHEDL     the input schedule updated to include the intervals
C                of coverage for this segment. The schedule has
C                been adjusted to account for the provided tolerance
C                value. Coverage lying outside the interval
C
C                   DC(1) - TOL : DC(2) + TOL
C
C                is excluded.
C
C                The elements of SCHEDL are given in the time system
C                indicated by TIMSYS.
C
C$ Parameters
C
C     Several parameters associated with the type 06 C-kernel
C     are utilized to compute the packet size of each subtype.
C     See the include file 'ck06.inc' for details.
C
C$ Exceptions
C
C     1)  The error SPICE(NOTSUPPORTED) is signaled if the subtype of
C         the CK type 06 segment is not recognized.
C
C     2)  Routines in the call tree of this routine may signal errors
C         if insufficient room in SCHEDL exists or other error
C         conditions relating to file access arise.
C
C     3)  If TOL is negative, the error SPICE(VALUEOUTOFRANGE) is
C         signaled.
C
C     4)  If TIMSYS is not recognized, the error SPICE(INVALIDOPTION)
C         is signaled.
C
C     5)  If a time conversion error occurs, the error will be
C         diagnosed by a routine in the call tree of this routine.
C
C$ Files
C
C     This routine reads the contents of the file associated with
C     HANDLE to locate coverage intervals.
C
C$ Particulars
C
C     This is a utility routine that determines the intervals
C     of coverage for a type 06 C-kernel segment.
C
C$ Examples
C
C     See CKCOV.
C
C$ Restrictions
C
C     None.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     N.J. Bachman    (JPL)
C     B.V. Semenov    (JPL)
C     W.L. Taber      (JPL)
C     F.S. Turner     (JPL)
C
C$ Version
C
C-    SPICELIB Version 1.0.0, 05-FEB-2014 (NJB) (BVS) (FST) (WLT)
C
C-&

C
C     SPICELIB Functions
C
      LOGICAL               EQSTR
      LOGICAL               FAILED
      LOGICAL               RETURN

C
C     Number of elements in a type 6 mini-segment
C     interval directory:
C
      INTEGER               NVDSIZ
      PARAMETER           ( NVDSIZ = 100 )

C
C     Mini-segment epoch directory size:
C
      INTEGER               DIRSIZ
      PARAMETER           ( DIRSIZ = 100 )

C
C     Type 6 control area size:
C
      INTEGER               NSGPAR
      PARAMETER           ( NSGPAR = 2 )

C
C     Type 6 mini-segment control area size:
C
      INTEGER               MCTLSZ
      PARAMETER           ( MCTLSZ = 4 )

C
C     Local Variables
C
      DOUBLE PRECISION      BEGIN
      DOUBLE PRECISION      BUFFER ( MCTLSZ )
      DOUBLE PRECISION      ET
      DOUBLE PRECISION      FINISH
      DOUBLE PRECISION      IVLBDS ( 2 )
      DOUBLE PRECISION      LSTEPC

      INTEGER               EPADDR
      INTEGER               I
      INTEGER               IVLBAS
      INTEGER               MINIE
      INTEGER               NDIR
      INTEGER               NINTVL
      INTEGER               NIVDIR
      INTEGER               NREC
      INTEGER               PTRBAS

      LOGICAL               ISTDB

C
C     Standard SPICE error handling.
C
      IF ( RETURN() ) THEN
         RETURN
      END IF

      CALL CHKIN ( 'ZZCKCV06' )

C
C     Check tolerance value.
C
      IF ( TOL .LT. 0.D0 ) THEN

         CALL SETMSG ( 'Tolerance must be non-negative; actual value '//
     .                 'was #.'                                       )
         CALL ERRDP  ( '#',  TOL                                      )
         CALL SIGERR ( 'SPICE(VALUEOUTOFRANGE)'                       )
         CALL CHKOUT ( 'ZZCKCV06'                                     )
         RETURN

      END IF

C
C     Set a logical flag indicating whether the time system is SCLK.
C
      ISTDB = EQSTR ( TIMSYS, 'TDB' )

C
C     Check time system.
C
      IF ( .NOT. ISTDB ) THEN

         IF (  .NOT.  EQSTR ( TIMSYS, 'SCLK' )  )THEN

            CALL SETMSG ( 'Time system spec TIMSYS was #; allowed ' //
     .                    'values are SCLK and TDB.'                )
            CALL ERRCH  ( '#',  TIMSYS                              )
            CALL SIGERR ( 'SPICE(INVALIDOPTION)'                    )
            CALL CHKOUT ( 'ZZCKCV06'                                )
            RETURN

         END IF

      END IF

C
C     Fetch the mini-segment count from the segment.
C
      CALL DAFGDA ( HANDLE, ARREND, ARREND, BUFFER )

      NINTVL = NINT( BUFFER(1) )

C
C     Each mini-segment contributes a coverage interval to the
C     total coverage of the segment. Since mini-segments can
C     contain gaps, we need to examine not only the mini-segment
C     interval bounds but the final epochs of the mini-segments.
C
C     Let IVLBAS be the base address of the mini-segment interval
C     bounds. Let PTRBAS be the base address of the mini-segment
C     pointers.
C
C     First compute PTRBAS. There are NINTVL+1 pointers.
C
      PTRBAS = ARREND - NSGPAR - ( NINTVL + 1 )

C
C     Compute the number of mini-segment interval directories.
C     There are NINTVL + 1 interval boundaries, so the directory
C     count is
C
C        (  ( NINTVL + 1 ) - 1  )  /  NVDSIZ
C
C
      NIVDIR = NINTVL / NVDSIZ

C
C     The interval bounds and their directories precede the
C     mini-segment pointers.
C
      IVLBAS = PTRBAS - NIVDIR - ( NINTVL + 1 )

C
C     Now loop over the mini-segments and find the contribution
C     from each one.
C
      DO I = 1,  NINTVL
C
C        Find the interval bounds for this mini-segment.
C
         CALL DAFGDA ( HANDLE, IVLBAS+I, IVLBAS+I+1, IVLBDS )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZCKCV06' )
            RETURN
         END IF

C
C        Now find the last epoch of this mini-segment, since
C        there could be a gap at the end.
C
C        Find the begin and end pointers for the current
C        mini-segment. Convert these from relative to
C        absolute DAF addresses.
C
         CALL DAFGDA ( HANDLE, PTRBAS+I, PTRBAS+I+1, BUFFER )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZCKCV06' )
            RETURN
         END IF

         MINIE = ( ARRBEG - 1 )  +  NINT( BUFFER(2) )  -  1

C
C        Fetch the mini-segment's record count NREC.
C
         CALL DAFGDA ( HANDLE, MINIE, MINIE, BUFFER )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZCKCV06' )
            RETURN
         END IF

         NREC = NINT( BUFFER(1) )

C
C        Compute the number of epoch directories for this
C        mini-segment.
C
         NDIR = ( NREC - 1 ) / DIRSIZ

C
C        The last epoch precedes the mini-segment control
C        area and the epoch directories.
C
         EPADDR = MINIE - MCTLSZ - NDIR

         CALL DAFGDA ( HANDLE, EPADDR, EPADDR, LSTEPC )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'ZZCKCV06' )
            RETURN
         END IF

         BEGIN  = IVLBDS(1)
C
C        The smaller of LSTEPC and IVLBDS(2) is the
C        end of the mini-segment's coverage.
C
         FINISH = MIN ( LSTEPC, IVLBDS(2) )
C
C        Truncate the interval using the segment bounds.
C
         BEGIN   =  MAX ( BEGIN,  DC(1) )
         FINISH  =  MIN ( FINISH, DC(2) )

C
C        Adjust the interval using the tolerance. Empty
C        intervals *do not get expanded*; this choice is
C        consistent with the type 6 reading algorithm.
C
         IF ( BEGIN .LE. FINISH ) THEN

            IF ( TOL .GT. 0.D0 ) THEN

               BEGIN   =  MAX( BEGIN  - TOL, 0.D0 )
               FINISH  =       FINISH + TOL

            END IF

         END IF

C
C        Convert the time to TDB if necessary.
C
         IF ( ISTDB ) THEN

            CALL SCT2E ( SCLKID, BEGIN,  ET )
            BEGIN  = ET

            CALL SCT2E ( SCLKID, FINISH, ET )
            FINISH = ET

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'ZZCKCV06' )
               RETURN
            END IF

         END IF

C
C        Insert the interval into the window.
C
         IF ( BEGIN .LE. FINISH ) THEN

            CALL WNINSD ( BEGIN, FINISH, SCHEDL )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'ZZCKCV06' )
               RETURN
            END IF

         END IF

      END DO

      CALL CHKOUT ( 'ZZCKCV06' )
      RETURN
      END


      SUBROUTINE LHC_HIGGS_CPV(PAR,PROB)

***********************************************************************
*   Subroutine to check Higgs LHC constraints:
*      PROB(45) =/= 0: Bound on Br(t->bH+)*BR(H+->tau nu)
*      PROB(46) =/= 0:  No Higgs in the MHmin-MHmax GeV range
*      PROB(47) =/= 0:  chi2gam > chi2max
*      PROB(48) =/= 0:  chi2bb > chi2max
*      PROB(49) =/= 0:  chi2zz > chi2max
*      PROB(51) =/= 0: excluded by ggF/bb->H/A->tautau
*      PROB(52) =/= 0: Excluded H_125->AA->4mu
***********************************************************************

      IMPLICIT NONE

      CHARACTER*256 FILENAME,EXPCON_PATH,catpath

      INTEGER I,I1,J,J1,NX,NX13,NY,JBAR,JBARbb,K,K1,K2,K3
      PARAMETER(NX=18,NX13=10,NY=6)

      DOUBLE PRECISION PAR(*),PROB(*)
      DOUBLE PRECISION HMAS(NX),XSM(NX),XSMbb(NX),LCMS(NX),LCMSbb(NX)
      DOUBLE PRECISION LATLAS(NX),LATLASbb(NX)
      DOUBLE PRECISION HMAS13(NX13),XSM13(NX13),XSMbb13(NX13)
      DOUBLE PRECISION LATLAS13(NX13),LATLASbb13(NX13)
      DOUBLE PRECISION MH(5),XSMH(5),LCMSH(5),SIG1(5),LATLASH(5)
      DOUBLE PRECISION XSMHbb(5),LCMSHbb(5),SIGbb(5),LATLASHbb(5)
      DOUBLE PRECISION DEL,SIGTOT,MBAR,LCMSMB,LATLASMB
      DOUBLE PRECISION SIGTOTbb,MBARbb,LCMSMBbb,LATLASMBbb
      DOUBLE PRECISION X1(NY),LSIGBR(NY),LIMIT,LHC_TBH
      DOUBLE PRECISION D1,D2,CJ2,BRHTOAA,MHcen,masstest
      DOUBLE PRECISION agg,bgg,cgg,mugcengg,muvcengg,SSIG(6)
      DOUBLE PRECISION abb,bbb,cbb,mugcenbb,muvcenbb
      DOUBLE PRECISION azz,bzz,czz,mugcenzz,muvcenzz
      DOUBLE PRECISION BRJJSM,BREESM,BRMMSM,BRLLSM,BRCCSM
      DOUBLE PRECISION BRBBSM,BRTTSM,BRWWSM,BRZZSM,BRGGSM,BRZGSM
      DOUBLE PRECISION ggHgg(100,2),dummy(100,4),SMXS(100,2)

      DOUBLE PRECISION MHC,XC(2,2),MH0(5),XH(5,5),MA2
      DOUBLE PRECISION CU(5),CUP(5),CD(5),CDP(5),CB(5),CBP(5),CJ(5),
     . CJP(5),CI(5),CG(5),CGP(5),CV(5),CZG(5),CZGP(5)
      DOUBLE PRECISION BRJJ(5),BREE(5),BRMM(5),BRLL(5),
     . BRCC(5),BRBB(5),BRTT(5),BRWW(5),BRZZ(5),BRGG(5),BRZG(5)
      DOUBLE PRECISION BRHHH(5,10),BRHCHC(5),BRHAZ(5,4),BRHCW(5),
     . BRHIGGS(5)
      DOUBLE PRECISION BRNEU(5,5,5),BRCHA(5,3),BRHSQ(5,10),BRHSL(5,7),
     . BRSUSY(5)
      DOUBLE PRECISION brtopbw,brtopbh,brtopneutrstop(5,2)
      DOUBLE PRECISION HCBRM,HCBRL,HCBRSU,HCBRBU,HCBRSC,HCBRBC,HCBRBT
      DOUBLE PRECISION MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      DOUBLE PRECISION SIG(5,10),muH2

      COMMON/HISPEC/MHC,XC,MH0,XH,MA2
      COMMON/HNSMCOUP/CU,CUP,CD,CDP,CB,CBP,CJ,CJP,CI,CG,CGP,CV,CZG,CZGP
      COMMON/HNSMBR/BRJJ,BREE,BRMM,BRLL,BRCC,BRBB,BRTT,BRWW,BRZZ,
     . BRGG,BRZG
      COMMON/HNHIBR/BRHHH,BRHCHC,BRHAZ,BRHCW,BRHIGGS
      COMMON/HNSUSYBR/BRNEU,BRCHA,BRHSQ,BRHSL,BRSUSY
      COMMON/BR_top2body/brtopbw,brtopbh,brtopneutrstop
      COMMON/HCSMBR/HCBRM,HCBRL,HCBRSU,HCBRBU,HCBRSC,HCBRBC,HCBRBT
      COMMON/HIGGSFIT/MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      COMMON/LHCSIGCPV/SIG
      COMMON/HIGGSMS/muH2

***********************************************************************
* 8 TeV limits
      DATA HMAS/90d0,100d0,120d0,140d0,160d0,180d0,200d0,250d0,300d0,
     . 350d0,400d0,450d0,500d0,600d0,700d0,800d0,900d0,1000d0/

* SM Higgs ggF prod. cross sect. at 8 TeV from
* https://twiki.cern.ch/twiki/bin/view/LHCPhysics/
* CERNYellowReportPageAt8TeV#gluon_gluon_Fusion_Process
      DATA XSM/36.32d0,29.68d0,20.8d0,15.42d0,11.96d0,8.98d0,7.081d0,
     . 4.783d0,3.594d0,3.401d0,2.921d0,2.002d0,1.283d0,.523d0,.229d0,
     . .1097d0,.0571d0,.032d0/

* SM Higgs bbH prod. cross sect. at 8 TeV from
* https://twiki.cern.ch/twiki/bin/view/LHCPhysics/
* /CrossSectionsFigures#MSSM_WG_plots (estimated)
      DATA XSMbb/0.56d0,0.42d0,0.25d0,0.15d0,8.7d-2,5.1d-2,3.2d-2,
     . 1.2d-2,4.5d-3,2.8d-3,1.4d-3,8.2d-4,4.9d-4,2.6d-4,1.2d-4,
     . 5.2d-5,2.4d-5,1.2d-5/

* Upper limit on ggF->H->tautau (8 TeV) from CMS-PAS-HIG-13-021, Tab. 7
      DATA LCMS/50.2d0,31.3d0,7.38d0,2.27d0,.845d0,.549d0,.517d0,.315d0,
     . .15d0,.112d0,.103d0,.607d-1,.385d-1,.193d-1,.143d-1,.115d-1,
     . .923d-2,.865d-2/

* Upper limit on bbH->tautau (8 TeV) from CMS-PAS-HIG-13-021, Tab. 8
      DATA LCMSbb/6.03d0,4.14d0,1.76d0,1.25d0,.814d0,.659d0,.553d0,
     . .217d0,
     . .975d-1,.638d-1,.613d-1,.431d-1,.320d-1,.203d-1,.173d-1,.166d-1,
     . .146d-1,.133d-1/

* Upper limit on ggF->H->tautau (8 TeV) from ATLAS-CONF-2014-049, Fig. 7
      DATA LATLAS/29.1d0,24.0d0,5.25d0,2.02d0,1.39d0,1.00d0,.794d0,
     .  .281d0,.127d0,.112d0,.773d-1,.400d-1,.240d-1,.177d-1,.127d-1,
     .  .993d-2,.840d-2,.735d-2/

* Upper limit on bbH->tautau (8 TeV) from ATLAS-CONF-2014-049, Fig. 7
      DATA LATLASbb/6.32d0,6.32d0,2.73d0,1.27d0,.966d0,.606d0,.393d0,
     .  .305d0,.116d0,.101d0,.656d-1,.363d-1,.238d-1,.159d-1,.117d-1,
     .  .943d-2,.785d-2,.716d-2/

***********************************************************************
* 13 TeV limits
      DATA HMAS13/200d0,300d0,350d0,400d0,500d0,600d0,700d0,800d0,
     . 1000d0,1200d0/

* SM Higgs ggF prod. cross sect. at 13 TeV from
* https://twiki.cern.ch/twiki/bin/view/LHCPhysics/
      DATA XSM13/1.812d1,9.823d0,1.025d1,1.000d1,4.538d0,2.006d0,
     . 9.235d-1,4.491d-1,1.233d-1,3.958d-2/

* SM Higgs bbH prod. cross sect. at 13 TeV from
* https://twiki.cern.ch/twiki/bin/view/LHCPhysics/
      DATA XSMbb13/1.000d-1,2.180d-2,1.174d-2,6.731d-3,2.547d-3,
     . 1.101d-3,5.251d-4,2.692d-4,8.258d-5,2.950d-5/

* Upper limit on ggF->H->tautau (13 TeV) from ATLAS-CONF-2016-085, Tab. 4
      DATA LATLAS13/2.1d0,5.9d-1,2.1d-1,1.5d-1,6.3d-2,3.0d-2,
     . 2.2d-2,1.8d-2,1.5d-2,1.4d-2/

* Upper limit on bbH->tautau (13 TeV) from ATLAS-CONF-2016-085, Tab. 5
      DATA LATLASbb13/2.0d0,5.7d-1,3.3d-1,2.7d-1,1.4d-1,5.4d-2,
     . 3.6d-2,2.5d-2,1.6d-2,1.3d-2/

***********************************************************************

      DATA X1/.25d0,.5d0,.75d0,1d0,2d0,3d0/
      DATA LSIGBR/3.8d-5,3.6d-5,4.1d-5,4.2d-5,4.4d-5,4.6d-5/

***********************************************************************

c       I- Constraints from ggF/bb->H/A->tautau

* Loop over 5 Higgses
      DO I=1,5
        MH(I)=dsqrt(MH0(I))

* 8 TeV limits
        J=1
        DOWHILE(HMAS(J).LE.MH(I) .AND. J.LT.NX)
          J=J+1
        ENDDO
        IF(J.GE.2 .AND. MH(I).LT.HMAS(NX)) THEN

* SM Higgs ggF prod. cross sect.:
          XSMH(I)=XSM(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(XSM(J)-XSM(J-1))
* ggF Signal cross section*BR:
          SIG1(I)=(CJ(I)**2+CJP(I)**2)*BRLL(I)*XSMH(I)

* CMS ggF limit:
          LCMSH(I)=LCMS(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(LCMS(J)-LCMS(J-1))
          PROB(51)=PROB(51)+DDIM(1d0,LCMSH(I)/SIG1(I))

* ATLAS ggF limit:
          LATLASH(I)=LATLAS(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(LATLAS(J)-LATLAS(J-1))
* Correct for jump in Fig.7 at MA=200 GeV: J=8,
* modif. LATLAS(J-1)=LATLAS(7)=.96D0 and not .794d0:
          IF(J.EQ.8) THEN
            LATLASH(I)=.96D0+(MH(I)-HMAS(J-1))/
     .        (HMAS(J)-HMAS(J-1))*(LATLAS(J)-.96D0)
          ENDIF
          PROB(51)=PROB(51)+DDIM(1D0,LATLASH(I)/SIG1(I))

* SM Higgs bbH prod. cross sect.:
          XSMHbb(I)=XSMbb(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(XSMbb(J)-XSMbb(J-1))
* bbH Signal cross section*BR:
          SIGbb(I)=(CB(I)**2+CBP(I)**2)*XSMHbb(I)*BRLL(I)

* CMS Hbb limit:
          LCMSHbb(I)=LCMSbb(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(LCMSbb(J)-LCMSbb(J-1))
          PROB(51)=PROB(51)+DDIM(1d0,LCMSHbb(I)/SIGbb(I))

* ATLAS Hbb limit:
          LATLASHbb(I)=LATLASbb(J-1)+(MH(I)-HMAS(J-1))/
     .      (HMAS(J)-HMAS(J-1))*(LATLASbb(J)-LATLASbb(J-1))
* Correct for jump in Fig.7 at MA=200 GeV: J=8,
* modif. LATLASbb(J-1)=LATLASbb(7)=.858D0 and not .393d0:
          IF(J.EQ.8) THEN
            LATLASHbb(I)=.858d0+(MH(I)-HMAS(J-1))/
     .        (HMAS(J)-HMAS(J-1))*(LATLASbb(J)-.858d0)
          ENDIF
          PROB(51)=PROB(51)+DDIM(1d0,LATLASHbb(I)/SIGbb(I))

* Combine signal rates of 2 Higgses
          DO I1=1,I-1
            J1=1
            DOWHILE(HMAS(J1).LE.MH(I1) .AND. J1.LT.NX)
              J1=J1+1
            ENDDO
            IF(MH(I1).GE.HMAS(1) .AND. MH(I1).LT.HMAS(NX)) THEN

* Average masses weighted by the signal rates (MBAR for ggF, MBARbb for bbH):
             MBAR=(SIG1(I)*MH(I)+SIG1(I1)*MH(I1))/(SIG1(I)+SIG1(I1))
             JBAR=1
             DOWHILE(HMAS(JBAR).LE.MBAR.AND.JBAR.LT.NX)
               JBAR=JBAR+1
             ENDDO
             MBARbb=(SIGbb(I)*MH(I)
     .         +SIGbb(I1)*MH(I1))/(SIGbb(I)+SIGbb(I1))
             JBARbb=1
             DOWHILE(HMAS(JBARbb).LE.MBARbb.AND.JBARbb.LT.NX)
               JBARbb=JBARbb+1
             ENDDO
* DEL=mass difference divided by a (small) resolution squared:
* [DEL < 1 only if |MH(I)-MH(I1)| < (MH(I)+MH(I1))/15d0;
*  otherwise the combined signal rate is small]
             DEL=((MH(I)-MH(I1))/(MH(I)+MH(I1))*15d0)**2

* Estimate of the combined ggF signal rates:
             SIGTOT=SIG1(I)+SIG1(I1)
     .         -SIG1(I)*SIG1(I1)*DEL/(SIG1(I)+SIG1(I1))
* Continue only if SIGTOT > 0 and 90<MBAR<1000
*      and |MH(I)-MH(I1)|/MBAR<0.20:
             IF(SIGTOT.GT.0D0.AND.MBAR.GE.HMAS(1).AND.
     .         MBAR.LT.HMAS(NX).AND.
     .         dabs(MH(I)-MH(I1))/MBAR.LE.0.20d0) THEN

* CMS ggF limit at MBAR:
               LCMSMB=LCMS(JBAR-1)+(MBAR-HMAS(JBAR-1))/
     .          (HMAS(JBAR)-HMAS(JBAR-1))*(LCMS(JBAR)-LCMS(JBAR-1))
               PROB(51)=PROB(51)+DDIM(1d0,LCMSMB/SIGTOT)

* ATLAS ggF limit at MBAR:
               LATLASMB=LATLAS(JBAR-1)+(MBAR-HMAS(JBAR-1))/
     .          (HMAS(JBAR)-HMAS(JBAR-1))*(LATLAS(JBAR)-LATLAS(JBAR-1))
* Correct for jump in Fig.7 at MA=200 GeV: JBAR=8,
* modif. LATLAS(JBAR-1)=LATLAS(7)=.96D0 and not .794d0:
               IF(J.EQ.8) THEN
                 LATLASMB=.96D0+(MBAR-HMAS(JBAR-1))/
     .            (HMAS(JBAR)-HMAS(JBAR-1))*(LATLAS(JBAR)-.96D0)
               ENDIF
               PROB(51)=PROB(51)+DDIM(1D0,LATLASMB/SIGTOT)
             ENDIF

* Estimate of the combined bbH signal rates:
             SIGTOTbb=SIGbb(I)+SIGbb(I1)
     .         -SIGbb(I)*SIGbb(I1)*DEL/(SIGbb(I)+SIGbb(I1))
* Continue only if SIGTOTbb > 0 and 90<MBARbb<1000
*      and |MH(I)-MH(I1)|/MBARbb<0.20:
             IF(SIGTOTbb.GT.0D0.AND.MBARbb.GE.HMAS(1).AND.
     .         MBARbb.LT.HMAS(NX).AND.
     .         dabs(MH(I)-MH(I1))/MBARbb.LE.0.20d0) THEN

* CMS bbH limit at MBARbb:
               LCMSMBbb=LCMSbb(JBARbb-1)+(MBARbb-HMAS(JBARbb-1))/
     .           (HMAS(JBARbb)-HMAS(JBARbb-1))*
     .           (LCMSbb(JBARbb)-LCMSbb(JBARbb-1))
               PROB(51)=PROB(51)+DDIM(1d0,LCMSMBbb/SIGTOTbb)

* ATLAS bbH limit at MBARbb:
               LATLASMBbb=LATLASbb(JBARbb-1)+(MBARbb-HMAS(JBARbb-1))/
     .           (HMAS(JBARbb)-HMAS(JBARbb-1))*
     .           (LATLASbb(JBARbb)-LATLASbb(JBARbb-1))
* Correct for jump in Fig.7 at MA=200 GeV: JBARbb=8,
* modif. LATLASbb(JBARbb-1)=LATLASbb(7)=.858D0 and not .393d0:
               IF(J.EQ.8) THEN
                 LATLASMBbb=.858D0+(MBARbb-HMAS(JBARbb-1))/
     .             (HMAS(JBARbb)-HMAS(JBARbb-1))*
     .             (LATLASbb(JBARbb)-.858D0)
               ENDIF
               PROB(51)=PROB(51)+DDIM(1D0,LATLASMBbb/SIGTOTbb)
             ENDIF
            ENDIF
          ENDDO
        ENDIF

* 13 TeV limits
        J=1
        DOWHILE(HMAS13(J).LE.MH(I) .AND. J.LT.NX13)
          J=J+1
        ENDDO
        IF(J.GE.2 .AND. MH(I).LT.HMAS13(NX13)) THEN

* SM Higgs ggF prod. cross sect.:
          XSMH(I)=XSM13(J-1)+(MH(I)-HMAS13(J-1))/
     .      (HMAS13(J)-HMAS13(J-1))*(XSM13(J)-XSM13(J-1))
* ggF Signal cross section*BR:
          SIG1(I)=(CJ(I)**2+CJP(I)**2)*BRLL(I)*XSMH(I)

* ATLAS ggF limit:
          LATLASH(I)=LATLAS13(J-1)+(MH(I)-HMAS13(J-1))/
     .      (HMAS13(J)-HMAS13(J-1))*(LATLAS13(J)-LATLAS13(J-1))
          PROB(51)=PROB(51)+DDIM(1D0,LATLASH(I)/SIG1(I))

* SM Higgs bbH prod. cross sect.:
          XSMHbb(I)=XSMbb13(J-1)+(MH(I)-HMAS13(J-1))/
     .      (HMAS13(J)-HMAS13(J-1))*(XSMbb13(J)-XSMbb13(J-1))
* bbH Signal cross section*BR:
          SIGbb(I)=(CB(I)**2+CBP(I)**2)**2*XSMHbb(I)*BRLL(I)

* ATLAS Hbb limit:
          LATLASHbb(I)=LATLASbb13(J-1)+(MH(I)-HMAS13(J-1))/
     .      (HMAS13(J)-HMAS13(J-1))*(LATLASbb13(J)-LATLASbb13(J-1))
          PROB(51)=PROB(51)+DDIM(1d0,LATLASHbb(I)/SIGbb(I))

* Combine signal rates of 2 Higgses
          DO I1=1,I-1
            J1=1
            DOWHILE(HMAS13(J1).LE.MH(I1) .AND. J1.LT.NX13)
              J1=J1+1
            ENDDO
            IF(MH(I1).GE.HMAS13(1) .AND. MH(I1).LT.HMAS13(NX13))THEN

* Average masses weighted by the signal rates (MBAR for ggF, MBARbb for bbH):
             MBAR=(SIG1(I)*MH(I)+SIG1(I1)*MH(I1))/(SIG1(I)+SIG1(I1))
             JBAR=1
             DOWHILE(HMAS13(JBAR).LE.MBAR .AND. JBAR.LT.NX13)
               JBAR=JBAR+1
             ENDDO
             MBARbb=(SIGbb(I)*MH(I)
     .         +SIGbb(I1)*MH(I1))/(SIGbb(I)+SIGbb(I1))
             JBARbb=1
             DOWHILE(HMAS13(JBARbb).LE.MBARbb .AND. JBARbb.LT.NX13)
               JBARbb=JBARbb+1
             ENDDO
* DEL=mass difference divided by a (small) resolution squared:
* [DEL < 1 only if |MH(I)-MH(I1)| < (MH(I)+MH(I1))/15d0;
*  otherwise the combined signal rate is small]
             DEL=((MH(I)-MH(I1))/(MH(I)+MH(I1))*15d0)**2

* Estimate of the combined ggF signal rates:
             SIGTOT=SIG1(I)+SIG1(I1)
     .         -SIG1(I)*SIG1(I1)*DEL/(SIG1(I)+SIG1(I1))
* Continue only if SIGTOT > 0 and 200<MBAR<1200
*      and |MH(I)-MH(I1)|/MBAR<0.20:
             IF(SIGTOT.GT.0D0.AND.MBAR.GE.HMAS13(1).AND.
     .         MBAR.LT.HMAS13(NX13).AND.
     .         dabs(MH(I)-MH(I1))/MBAR.LE.0.20d0) THEN

* ATLAS ggF limit at MBAR:
               LATLASMB=LATLAS13(JBAR-1)+(MBAR-HMAS13(JBAR-1))/
     .          (HMAS13(JBAR)-HMAS13(JBAR-1))*
     .          (LATLAS13(JBAR)-LATLAS13(JBAR-1))
               PROB(51)=PROB(51)+DDIM(1D0,LATLASMB/SIGTOT)
             ENDIF

* Estimate of the combined bbH signal rates:
             SIGTOTbb=SIGbb(I)+SIGbb(I1)
     .         -SIGbb(I)*SIGbb(I1)*DEL/(SIGbb(I)+SIGbb(I1))
* Continue only if SIGTOTbb > 0 and 200<MBARbb<1200
*      and |MH(I)-MH(I1)|/MBARbb<0.20:
             IF(SIGTOTbb.GT.0D0.AND.MBARbb.GE.HMAS13(1).AND.
     .         MBARbb.LT.HMAS13(NX13).AND.
     .         dabs(MH(I)-MH(I1))/MBARbb.LE.0.20d0) THEN

* ATLAS bbH limit at MBARbb:
               LATLASMBbb=LATLASbb13(JBARbb-1)+
     .           (MBARbb-HMAS13(JBARbb-1))/
     .           (HMAS13(JBARbb)-HMAS13(JBARbb-1))*
     .           (LATLASbb13(JBARbb)-LATLASbb13(JBARbb-1))
               PROB(51)=PROB(51)+DDIM(1D0,LATLASMBbb/SIGTOTbb)
             ENDIF
            ENDIF
          ENDDO
        ENDIF
      ENDDO

c        II- Bound on Br(t->bH+)*BR(H+->tau nu)

      PROB(45)=DDIM(brtopbh*HCBRL/LHC_TBH(dsqrt(MHC)),1d0)

c        III- Constraints from ggF->H/A->gamgam from ATLAS-CONF-2014-031, M_H/A < 122

*   The EXPCON_PATH variable is set:
      CALL getenv('EXPCON_PATH',EXPCON_PATH)
      if(EXPCON_PATH.eq.' ')  EXPCON_PATH='../EXPCON'

* Read ATLAS upper limit
* ggHgg(I,1): Higgs mass
* ggHgg(I,2): upper limit in fb
      FILENAME=catpath(EXPCON_PATH,'ggHgg.dat')
      OPEN(11,FILE=FILENAME,STATUS='UNKNOWN',ERR=1)
      I=1
 1801 READ(11,*,END=1802,ERR=2)(dummy(I,J),J=1,4)
      ggHgg(I,1)=dummy(I,1)
      ggHgg(I,2)=dummy(I,4)
      I=I+1
      GOTO 1801
 1802 CLOSE(11)

* Read SM Higgs ggF production cross section (60-122 GeV)
* SMXS(I,1): Higgs mass
* SMXS.65-122.dat:  ggF production cross section in pb
* SMXS(I,2): ggF production cross section in fb
      FILENAME=catpath(EXPCON_PATH,'SMXS.65-122.dat')
      OPEN(11,FILE=FILENAME,STATUS='UNKNOWN',ERR=1)
      I=1
 1811 READ(11,*,END=1812,ERR=2)(SMXS(I,J),J=1,2)
      SMXS(I,2)=1d3*SMXS(I,2)
      I=I+1
      GOTO 1811
 1812 CLOSE(11)

* Loop over 5 Higgses
      DO I=1,5
        J=1
        DOWHILE(SMXS(J,1).LE.dsqrt(MH0(I)) .AND. J.LT.70)
          J=J+1
        ENDDO

       IF(J.GE.2 .AND. dsqrt(MH0(I)).LT.122d0) THEN
        XSMH(I)=0d0
        LATLASH(I)=1d10
* SM Higgs ggF prod. cross sect.:
          XSMH(I)=SMXS(J-1,2)+(dsqrt(MH0(I))-SMXS(J-1,1))/
     .      (SMXS(J,1)-SMXS(J-1,1))*(SMXS(J,2)-SMXS(J-1,2))
* ggF Signal cross section*BR(H->gamgam):
          SIG(I,8)=(CJ(I)**2+CJP(I)**2)*BRGG(I)*XSMH(I)
* ATLAS limit:
          LATLASH(I)=ggHgg(J-1,2)+(dsqrt(MH0(I))-SMXS(J-1,1))/
     .      (SMXS(J,1)-SMXS(J-1,1))*(ggHgg(J,2)-ggHgg(J-1,2))
          PROB(53)=PROB(53)+DDIM(1d0,LATLASH(I)/SIG(I,8))

        ENDIF
        ENDDO

c       IV- Higgs test at ~125 GeV

c      1) Data

* adding linearly 1 GeV exp. + 2 GeV theor. errors
      MHmin=DSQRT(muH2)-3d0
      MHmax=DSQRT(muH2)+3d0
      chi2max=6.18d0

* From J. Bernon with run-II data (sep. 2016):

c Chi^2 from gammagamma:
      agg=17.47d0
      bgg=3.17d0
      cgg=6.26d0
      mugcengg=1.18d0
      muvcengg=1.07d0

c Chi^2 from bb/tautau:
      abb=4.81d0
      bbb=2.69d0
      cbb=21.57d0
      mugcenbb=1.27d0
      muvcenbb=0.86d0

c Chi^2 from ZZ/WW:
      azz=36.40d0
      bzz=4.56d0
      czz=8.16d0
      mugcenzz=1.11d0
      muvcenzz=1.37d0

c      2) Higgs signals / SM

      DO I=1,5

       DO J=1,10
        SIG(I,J)=0d0
       ENDDO

       CALL HDECAY(dsqrt(MH0(I)),BRJJSM,BREESM,BRMMSM,BRLLSM,
     .      BRCCSM,BRBBSM,BRTTSM,BRWWSM,BRZZSM,BRGGSM,BRZGSM)

*   H -> tautau
* VBF/VH
       IF(BRLLSM.NE.0d0)SIG(I,1)=CV(I)**2*BRLL(I)/BRLLSM
* ggF
       IF(BRLLSM.NE.0d0)SIG(I,2)=(CJ(I)**2+CJP(I)**2)*BRLL(I)/BRLLSM

*   H -> bb
* VBF/VH
       IF(BRBBSM.NE.0d0)SIG(I,3)=CV(I)**2*BRBB(I)/BRBBSM
* ttH
       IF(BRBBSM.NE.0d0)SIG(I,4)=(CU(I)**2+CUP(I)**2)*BRBB(I)/BRBBSM

*   H -> ZZ/WW
* VBF/VH
       IF(BRZZSM.NE.0d0)SIG(I,5)=CV(I)**2*BRZZ(I)/BRZZSM
* ggF
       IF(BRZZSM.NE.0d0)SIG(I,6)=(CJ(I)**2+CJP(I)**2)*BRZZ(I)/BRZZSM

*   H -> gammagamma
* VBF/VH
       IF(BRGGSM.NE.0d0)SIG(I,7)=CV(I)**2*BRGG(I)/BRGGSM
* ggF
       IF(BRGGSM.NE.0d0)SIG(I,8)=(CJ(I)**2+CJP(I)**2)*BRGG(I)/BRGGSM

*   H -> invisible
* VBF/VH
       SIG(I,9)=CV(I)**2*BRNEU(I,1,1)
* ggF
       SIG(I,10)=(CJ(I)**2+CJP(I)**2)*BRNEU(I,1,1)

      ENDDO

c      3) Chi^2 test of the couplings

      MHcen=(MHmin+MHmax)/2d0
      D1=(MHmax-MHmin)/2d0
      masstest=2d0
      K=0
      K1=0
      K2=0
      K3=0
      J=1

      DO I=1,6
       SSIG(I)=0d0
      ENDDO

      DO I=1,5
      masstest=min(masstest,dabs(dsqrt(MH0(I))-MHcen)/D1)
       IF(dabs(dsqrt(MH0(I))-MHcen).le.D1)THEN
        if(K.eq.2)then
         K3=I
         K=3
        endif
        if(K.eq.1)then
         K2=I
         K=2
        endif
        if(K.eq.0)then
         K1=I
         K=1
        endif
       ELSE
        if(K.eq.0.and.I.gt.1)then
         if(dabs(dsqrt(MH0(I))-MHcen)
     .  .lt.dabs(dsqrt(MH0(I-1))-MHcen))J=I
        endif
       ENDIF
      ENDDO

      IF(K.eq.0)THEN
       chi2gam=agg*(SIG(J,1)-mugcengg)**2+cgg*(SIG(J,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(J,1)-mugcengg)*(SIG(J,2)-muvcengg)
       chi2bb=abb*(SIG(J,3)-mugcenbb)**2+cbb*(SIG(J,4)-muvcenbb)**2
     .    +2d0*bbb*(SIG(J,3)-mugcenbb)*(SIG(J,4)-muvcenbb)
       chi2zz=azz*(SIG(J,5)-mugcenzz)**2+czz*(SIG(J,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(J,5)-mugcenzz)*(SIG(J,6)-muvcenzz)
      ENDIF

      IF(K.eq.1)THEN
       chi2gam=agg*(SIG(K1,1)-mugcengg)**2+cgg*(SIG(K1,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K1,1)-mugcengg)*(SIG(K1,2)-muvcengg)
       chi2bb=abb*(SIG(K1,3)-mugcenbb)**2+cbb*(SIG(K1,4)-muvcenbb)**2
     .    +2d0*bbb*(SIG(K1,3)-mugcenbb)*(SIG(K1,4)-muvcenbb)
       chi2zz=azz*(SIG(K1,5)-mugcenzz)**2+czz*(SIG(K1,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K1,5)-mugcenzz)*(SIG(K1,6)-muvcenzz)
      ENDIF

      IF(K.eq.2)THEN
       chi2gam=min(agg*(SIG(K1,1)-mugcengg)**2
     .                +cgg*(SIG(K1,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K1,1)-mugcengg)*(SIG(K1,2)-muvcengg),
     .     agg*(SIG(K2,1)-mugcengg)**2+cgg*(SIG(K2,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K2,1)-mugcengg)*(SIG(K2,2)-muvcengg))
       chi2zz=min(azz*(SIG(K1,5)-mugcenzz)**2
     .                +czz*(SIG(K1,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K1,5)-mugcenzz)*(SIG(K1,6)-muvcenzz),
     .      azz*(SIG(K2,5)-mugcenzz)**2+czz*(SIG(K2,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K2,5)-mugcenzz)*(SIG(K2,6)-muvcenzz))

        SSIG(1)=SIG(K1,8)+SIG(K2,8)
        SSIG(2)=SIG(K1,7)+SIG(K2,7)
        SSIG(3)=SIG(K1,2)+SIG(K2,2)
        SSIG(4)=SIG(K1,3)+SIG(K2,3)
        SSIG(5)=SIG(K1,6)+SIG(K2,6)
        SSIG(6)=SIG(K1,5)+SIG(K2,5)

        if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K2))).le.3d0)then
       chi2gam=agg*(SSIG(1)-mugcengg)**2+cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg)
       chi2zz=azz*(SSIG(5)-mugcenzz)**2+czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz)
        endif

       chi2bb=abb*(SSIG(3)-mugcenbb)**2+cbb*(SSIG(4)-muvcenbb)**2
     .    +2d0*bbb*(SSIG(3)-mugcenbb)*(SSIG(4)-muvcenbb)
      ENDIF

      IF(K.eq.3)THEN
       chi2gam=min(agg*(SIG(K1,1)-mugcengg)**2
     .                 +cgg*(SIG(K1,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K1,1)-mugcengg)*(SIG(K1,2)-muvcengg),
     .     agg*(SIG(K2,1)-mugcengg)**2+cgg*(SIG(K2,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K2,1)-mugcengg)*(SIG(K2,2)-muvcengg),
     .     agg*(SIG(K3,1)-mugcengg)**2+cgg*(SIG(K3,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K3,1)-mugcengg)*(SIG(K3,2)-muvcengg))
       chi2zz=min(azz*(SIG(K1,5)-mugcenzz)**2
     .                 +czz*(SIG(K1,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K1,5)-mugcenzz)*(SIG(K1,6)-muvcenzz),
     .      azz*(SIG(K2,5)-mugcenzz)**2+czz*(SIG(K2,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K2,5)-mugcenzz)*(SIG(K2,6)-muvcenzz),
     .      azz*(SIG(K3,5)-mugcenzz)**2+czz*(SIG(K3,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K3,5)-mugcenzz)*(SIG(K3,6)-muvcenzz))

        SSIG(1)=SIG(K1,8)+SIG(K2,8)+SIG(K3,8)
        SSIG(2)=SIG(K1,7)+SIG(K2,7)+SIG(K3,7)
        SSIG(3)=SIG(K1,2)+SIG(K2,2)+SIG(K3,2)
        SSIG(4)=SIG(K1,3)+SIG(K2,3)+SIG(K3,3)
        SSIG(5)=SIG(K1,6)+SIG(K2,6)+SIG(K3,6)
        SSIG(6)=SIG(K1,5)+SIG(K2,5)+SIG(K3,5)

        if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K3))).le.3d0)then
       chi2gam=agg*(SSIG(1)-mugcengg)**2+cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg)
       chi2zz=azz*(SSIG(5)-mugcenzz)**2+czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz)
        endif

       chi2bb=abb*(SSIG(3)-mugcenbb)**2+cbb*(SSIG(4)-muvcenbb)**2
     .    +2d0*bbb*(SSIG(3)-mugcenbb)*(SSIG(4)-muvcenbb)

        if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K3))).gt.3d0)then
         if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K2))).lt.3d0.and.
     .       dabs(dsqrt(MH0(K2))-dsqrt(MH0(K3))).gt.3d0)then
         SSIG(1)=SIG(K1,8)+SIG(K2,8)
         SSIG(2)=SIG(K1,7)+SIG(K2,7)
         SSIG(3)=SIG(K1,2)+SIG(K2,2)
         SSIG(4)=SIG(K1,3)+SIG(K2,3)
         SSIG(5)=SIG(K1,6)+SIG(K2,6)
         SSIG(6)=SIG(K1,5)+SIG(K2,5)
         chi2gam=min(agg*(SSIG(1)-mugcengg)**2
     .                       +cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg),
     .     agg*(SIG(K3,1)-mugcengg)**2+cgg*(SIG(K3,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K3,1)-mugcengg)*(SIG(K3,2)-muvcengg))
         chi2zz=min(azz*(SSIG(5)-mugcenzz)**2
     .                       +czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz),
     .      azz*(SIG(K3,5)-mugcenzz)**2+czz*(SIG(K3,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K3,5)-mugcenzz)*(SIG(K3,6)-muvcenzz))
         endif
         if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K2))).gt.3d0.and.
     .       dabs(dsqrt(MH0(K2))-dsqrt(MH0(K3))).lt.3d0)then
         SSIG(1)=SIG(K3,8)+SIG(K2,8)
         SSIG(2)=SIG(K3,7)+SIG(K2,7)
         SSIG(3)=SIG(K3,2)+SIG(K2,2)
         SSIG(4)=SIG(K3,3)+SIG(K2,3)
         SSIG(5)=SIG(K3,6)+SIG(K2,6)
         SSIG(6)=SIG(K3,5)+SIG(K2,5)
         chi2gam=min(agg*(SSIG(1)-mugcengg)**2
     .                              +cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg),
     .     agg*(SIG(K1,1)-mugcengg)**2+cgg*(SIG(K1,2)-muvcengg)**2
     .     +2d0*bgg*(SIG(K1,1)-mugcengg)*(SIG(K1,2)-muvcengg))
         chi2zz=min(azz*(SSIG(5)-mugcenzz)**2
     .                              +czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz),
     .      azz*(SIG(K1,5)-mugcenzz)**2+czz*(SIG(K1,6)-muvcenzz)**2
     .    +2d0*bzz*(SIG(K1,5)-mugcenzz)*(SIG(K1,6)-muvcenzz))
         endif
         if(dabs(dsqrt(MH0(K1))-dsqrt(MH0(K2))).lt.3d0.and.
     .       dabs(dsqrt(MH0(K2))-dsqrt(MH0(K3))).lt.3d0)then
         SSIG(1)=SIG(K1,8)+SIG(K2,8)
         SSIG(2)=SIG(K1,7)+SIG(K2,7)
         SSIG(3)=SIG(K1,2)+SIG(K2,2)
         SSIG(4)=SIG(K1,3)+SIG(K2,3)
         SSIG(5)=SIG(K1,6)+SIG(K2,6)
         SSIG(6)=SIG(K1,5)+SIG(K2,5)
         chi2gam=agg*(SSIG(1)-mugcengg)**2+cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg)
         chi2zz=azz*(SSIG(5)-mugcenzz)**2+czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz)
         SSIG(1)=SIG(K3,8)+SIG(K2,8)
         SSIG(2)=SIG(K3,7)+SIG(K2,7)
         SSIG(3)=SIG(K3,2)+SIG(K2,2)
         SSIG(4)=SIG(K3,3)+SIG(K2,3)
         SSIG(5)=SIG(K3,6)+SIG(K2,6)
         SSIG(6)=SIG(K3,5)+SIG(K2,5)
         chi2gam=min(agg*(SSIG(1)-mugcengg)**2
     .                  +cgg*(SSIG(2)-muvcengg)**2
     .     +2d0*bgg*(SSIG(1)-mugcengg)*(SSIG(2)-muvcengg),chi2gam)
         chi2zz=min(azz*(SSIG(5)-mugcenzz)**2
     .                  +czz*(SSIG(6)-muvcenzz)**2
     .    +2d0*bzz*(SSIG(5)-mugcenzz)*(SSIG(6)-muvcenzz),chi2zz)
         endif
        endif

      ENDIF

      IF(masstest.gt.1d0)PROB(46)=masstest

      PROB(47)=DDIM(chi2gam/chi2MAX,1d0)
      PROB(48)=DDIM(chi2bb/chi2MAX,1d0)
      PROB(49)=DDIM(chi2zz/chi2MAX,1d0)

c        V- CMS constraints on h[125]->2A->4mu

      PROB(52)=0d0

      DO I1=2,5

      CJ2=0d0
      BRHTOAA=0d0

      IF(dabs(dsqrt(MH0(I1))-MHcen).le.D1)THEN
       CJ2=CJ(I1)**2+CJP(I1)**2
       BRHTOAA=BRHHH(I1,1)
      ENDIF

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.X1(1).AND.X1(I).LE.dsqrt(MH0(1))
     .                                 .AND.I.LT.NY)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND.dsqrt(MH0(1)).LT.X1(NY))THEN
       LIMIT=LSIGBR(I-1)
     . +(dsqrt(MH0(1))-X1(I-1))/(X1(I)-X1(I-1))*(LSIGBR(I)-LSIGBR(I-1))
       PROB(52)=PROB(52)+DDIM(CJ2*BRHTOAA*BRMM(1)**2/LIMIT,1d0)
      ENDIF

      ENDDO

      RETURN

*   Error catch

 1    WRITE(*,*)"Cannot find the file ",FILENAME
      STOP

 2    WRITE(*,*)"Read error in the file ",FILENAME
      STOP

      END

      SUBROUTINE LHC_HSMAA_LEPTONS_CPV(PROB)

*     PROB(52) =/= 0: excluded

      IMPLICIT NONE

      CHARACTER*256 FILENAME,EXPCON_PATH,catpath

      INTEGER NHAATAUS1,NHAATAUS2,NHAABMU
      INTEGER NHAAMUS1,NHAAMUS2,NHAAMUS3
      INTEGER NHAAMUS4,I,J,K,NM
      PARAMETER(NM=14)

      DOUBLE PRECISION MHC,XC(2,2),MH0(5),XH(5,5),MA2
      DOUBLE PRECISION PROB(*)
      DOUBLE PRECISION D1,D2,CJ2BRHTOAA,MH,MHcen,LIMIT
      DOUBLE PRECISION MHSM(NM),SMXS_8TeV(NM),SMXS_125_8TeV,SMXS_J_8TeV
      DOUBLE PRECISION LOWBOUND,HIGHBOUND

      DOUBLE PRECISION BRJJ(5),BREE(5),BRMM(5),BRLL(5),
     . BRCC(5),BRBB(5),BRTT(5),BRWW(5),BRZZ(5),BRGG(5),BRZG(5)
      DOUBLE PRECISION BRHHH(5,10),BRHCHC(5),BRHAZ(5,4),BRHCW(5),
     . BRHIGGS(5)
      DOUBLE PRECISION CU(5),CUP(5),CD(5),CDP(5),CB(5),CBP(5),CJ(5),
     . CJP(5),CI(5),CG(5),CGP(5),CV(5),CZG(5),CZGP(5)
      DOUBLE PRECISION MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      DOUBLE PRECISION HAATAUS1(92,2),HAATAUS2(92,2),HAABMU(76,2)
      DOUBLE PRECISION HAAMUS1(20,2),HAAMUS2(12,2),HAAMUS3(7,2)
      DOUBLE PRECISION HAAMUS4(67,4)

      COMMON/HISPEC/MHC,XC,MH0,XH,MA2
      COMMON/HNSMBR/BRJJ,BREE,BRMM,BRLL,BRCC,BRBB,BRTT,BRWW,BRZZ,
     . BRGG,BRZG
      COMMON/HNHIBR/BRHHH,BRHCHC,BRHAZ,BRHCW,BRHIGGS
      COMMON/HNSMCOUP/CU,CUP,CD,CDP,CB,CBP,CJ,CJP,CI,CG,CGP,CV,CZG,CZGP
      COMMON/HIGGSFIT/MHmin,MHmax,chi2max,chi2gam,chi2bb,chi2zz
      COMMON/LHCHAA/HAATAUS1,HAATAUS2,HAABMU,
     .      HAAMUS1,HAAMUS2,HAAMUS3,HAAMUS4,
     .      NHAATAUS1,NHAATAUS2,NHAABMU,
     .      NHAAMUS1,NHAAMUS2,NHAAMUS3,NHAAMUS4

      DATA MHSM/85d0,90d0,95d0,100d0,105d0,110d0,115d0,120d0,125d0,
     . 130d0,135d0,140d0,145d0,150d0/
      DATA SMXS_8TeV/3.940d1,3.526d1,3.175d1,2.873d1,2.611d1,2.383d1,
     . 2.184d1,2.008d1,1.851d1,1.712d1,1.587d1,1.475d1,1.375d1,1.284d1/           ! in pb

* Determining the SM-like Higgs and its couplings / BR / XS

      CJ2BRHTOAA=0d0
      MHcen=(MHmin+MHmax)/2d0
      MH=0d0
      D2=0d0

      DO I=2,5
       D1=DDIM(dsqrt(MH0(I))/MHMAX,1d0)-DDIM(1d0,dsqrt(MH0(I))/MHMIN)
       IF(D1.EQ.0d0)THEN
        CJ2BRHTOAA=CJ2BRHTOAA+(CJ(I)**2+CJP(I)**2)*BRHHH(I,1)
        MH=MH+(CJ(I)**2+CJP(I)**2)*dsqrt(MH0(I))
        D2=D2+CJ(I)**2+CJP(I)**2
       ENDIF
      ENDDO
      MH=MH/Max(D2,1d-10)
      D1=DDIM(MH/MHMAX,1d0)-DDIM(1d0,MH/MHMIN)
      IF(D1.ne.0d0)THEN
       MH=MHcen
      ENDIF

      SMXS_125_8TeV=0d0
      I=1
      DOWHILE(MH.GE.MHSM(1) .AND. MHSM(I).LE.MH .AND. I.LT.NM)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. MH.LT.MHSM(NM))THEN
       SMXS_125_8TeV=SMXS_8TeV(I-1)
     .    +(MH-MHSM(I-1))/(MHSM(I)-MHSM(I-1))
     .         *(SMXS_8TeV(I)-SMXS_8TeV(I-1))
      ENDIF

* Constraints from ggF->HSM->AA->2mu2tau from 1505.01609 (ATLAS), M_A < 50GeV
* BR(A->2mu) converted in BR(A->2tau), normalized to SM XS

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAATAUS1(1,1)
     .        .AND. HAATAUS1(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAATAUS1)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAATAUS1(NHAATAUS1,1))THEN
       LIMIT=HAATAUS1(I-1,2)
     .    +(dsqrt(MH0(1))-HAATAUS1(I-1,1))
     .         /(HAATAUS1(I,1)-HAATAUS1(I-1,1))
     .         *(HAATAUS1(I,2)-HAATAUS1(I-1,2))
       PROB(52)=PROB(52)+DDIM(CJ2BRHTOAA*BRLL(1)**2/LIMIT,1d0)
      ENDIF

* Constraints from ggF->HSM->AA->4tau from 1510.06534 (CMS), 4GeV < M_A < 8GeV

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAATAUS2(1,1)
     .        .AND. HAATAUS2(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAATAUS2)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAATAUS2(NHAATAUS2,1))THEN
       LIMIT=HAATAUS2(I-1,2)
     .    +(dsqrt(MH0(1))-HAATAUS2(I-1,1))
     .         /(HAATAUS2(I,1)-HAATAUS2(I-1,1))
     .         *(HAATAUS2(I,2)-HAATAUS2(I-1,2))
       PROB(52)=PROB(52)
     .          +DDIM(SMXS_125_8TeV*CJ2BRHTOAA*BRLL(1)**2/LIMIT,1d0)
      ENDIF

* Constraints from ggF->HSM->AA->2mu2b from CMS-PAS-HIG-14-041, 25GeV < M_A < 63GeV
* normalized to SM XS

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAABMU(1,1)
     .        .AND. HAABMU(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAABMU)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAABMU(NHAABMU,1))THEN
       LIMIT=HAABMU(I-1,2)
     .    +(dsqrt(MH0(1))-HAABMU(I-1,1))
     .         /(HAABMU(I,1)-HAABMU(I-1,1))
     .         *(HAABMU(I,2)-HAABMU(I-1,2))
       PROB(52)=PROB(52)
     .          +DDIM(CJ2BRHTOAA*BRMM(1)*BRBB(1)/LIMIT,1d0)
      ENDIF

* Constraints from ggF->HSM->AA->2mu2tau from CMS-PAS-HIG-15-011, 19GeV < M_A < 57GeV
* BR(A->2tau) converted in BR(A->2mu), normalized to SM XS

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAAMUS1(1,1)
     .        .AND. HAAMUS1(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAAMUS1)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAAMUS1(NHAAMUS1,1))THEN
       LIMIT=HAAMUS1(I-1,2)
     .    +(dsqrt(MH0(1))-HAAMUS1(I-1,1))
     .         /(HAAMUS1(I,1)-HAAMUS1(I-1,1))
     .         *(HAAMUS1(I,2)-HAAMUS1(I-1,2))
       PROB(52)=PROB(52)
     .          +DDIM(CJ2BRHTOAA*BRMM(1)**2/LIMIT,1d0)
      ENDIF

* Constraints from ggF->HSM->AA->4tau from CMS-PAS-HIG-14-022, 5GeV < M_A < 14GeV
* BR(A->2tau) converted in BR(A->2mu), as shown in Fig7 of CMS-PAS-HIG-15-011,
* normalized to SM XS

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAAMUS2(1,1)
     .        .AND. HAAMUS2(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAAMUS2)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAAMUS2(NHAAMUS2,1))THEN
       LIMIT=HAAMUS2(I-1,2)
     .    +(dsqrt(MH0(1))-HAAMUS2(I-1,1))
     .         /(HAAMUS2(I,1)-HAAMUS2(I-1,1))
     .         *(HAAMUS2(I,2)-HAAMUS2(I-1,2))
       PROB(52)=PROB(52)
     .          +DDIM(CJ2BRHTOAA*BRMM(1)**2/LIMIT,1d0)
      ENDIF

* Constraints from ggF->HSM->AA->4tau from CMS-PAS-HIG-14-019, 3GeV < M_A < 8GeV
* BR(A->2tau) converted in BR(A->2mu), as shown in Fig7 of CMS-PAS-HIG-15-011,
* normalized to SM XS

      I=1
      DOWHILE(dsqrt(MH0(1)).GE.HAAMUS3(1,1)
     .        .AND. HAAMUS3(I,1).LE.dsqrt(MH0(1))
     .        .AND. I.LT.NHAAMUS3)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. dsqrt(MH0(1)).LT.HAAMUS3(NHAAMUS3,1))THEN
       LIMIT=HAAMUS3(I-1,2)
     .    +(dsqrt(MH0(1))-HAAMUS3(I-1,1))
     .         /(HAAMUS3(I,1)-HAAMUS3(I-1,1))
     .         *(HAAMUS3(I,2)-HAAMUS3(I-1,2))
       PROB(52)=PROB(52)
     .          +DDIM(CJ2BRHTOAA*BRMM(1)**2/LIMIT,1d0)
      ENDIF

* Constraints from ggF->H->AA->4mu from 1506.00424, 0.25GeV < M_A < 3.55GeV, 85GeV < m_H < 150GeV

      CJ2BRHTOAA=0d0

        DO J=2,5

      IF(J.ge.3 .and. dabs(dsqrt(MH0(J))-dsqrt(MH0(J-1))).lt.3d0)THEN
       IF(J.ge.4 .and. dabs(dsqrt(MH0(J))-dsqrt(MH0(J-2))).lt.3d0)THEN
        MH=((CJ(J-2)**2+CJP(J-2)**2)*dsqrt(MH0(J-2))
     .    +(CJ(J-1)**2+CJP(J-1)**2)*dsqrt(MH0(J-1))
     .    +(CJ(J)**2+CJP(J)**2)*dsqrt(MH0(J)))
     .  /Max(CJ(J)**2+CJ(J-1)**2+CJ(J-2)**2+CJP(J)**2+CJP(J-1)**2
     .                                           +CJP(J-2)**2,1d-10)
        CJ2BRHTOAA=CJ2BRHTOAA+(CJ(J)**2+CJP(J)**2)*BRHHH(J,1)
       ELSE
        MH=((CJ(J-1)**2+CJP(J-1)**2)*dsqrt(MH0(J-1))
     .    +(CJ(J)**2+CJP(J)**2)*dsqrt(MH0(J)))
     .            /Max(CJ(J)**2+CJ(J-1)**2+CJP(J)**2+CJP(J-1)**2,1d-10)
        CJ2BRHTOAA=CJ2BRHTOAA+(CJ(J)**2+CJP(J)**2)*BRHHH(J,1)
       ENDIF
      ELSE
       MH=dsqrt(MH0(J))
       CJ2BRHTOAA=(CJ(J)**2+CJP(J)**2)*BRHHH(J,1)
      ENDIF

      I=1
      DOWHILE(MH.GE.MHSM(1)
     .        .AND.MHSM(I).LE.MH.AND.I.LT.NM)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. MH.LT.MHSM(14))THEN
       SMXS_J_8TeV=SMXS_8TeV(I-1)
     .    +(MH-MHSM(I-1))/(MHSM(I)-MHSM(I-1))
     .         *(SMXS_8TeV(I)-SMXS_8TeV(I-1))
       SMXS_J_8TeV=SMXS_J_8TeV*1d3         ! converting in fb
      ENDIF

      I=1
      DOWHILE(MH.GE.HAAMUS4(1,1)
     .        .AND. HAAMUS4(I,1).LE.MH .AND. I.LT.NHAAMUS4)
       I=I+1
      ENDDO
      IF(I.GT.1 .AND. MH.LT.HAAMUS4(NHAAMUS4,1))THEN
       LOWBOUND=100d0
       HIGHBOUND=100d0
       IF(dsqrt(MH0(1)).ge.0.25d0 .and. dsqrt(MH0(1)).lt.2d0)THEN
        LOWBOUND=HAAMUS4(I-1,2)+(dsqrt(MH0(1))-0.25d0)/(2d0-0.25d0)
     .         *(HAAMUS4(I-1,3)-HAAMUS4(I-1,2))
        HIGHBOUND=HAAMUS4(I,2)+(dsqrt(MH0(1))-0.25d0)/(2d0-0.25d0)
     .         *(HAAMUS4(I,3)-HAAMUS4(I,2))
       ELSEIF(dsqrt(MH0(1)).ge.2d0 .and. dsqrt(MH0(1)).lt.3.55d0)THEN
        LOWBOUND=HAAMUS4(I-1,3)+(dsqrt(MH0(1))-2d0)/(3.55d0-2d0)
     .         *(HAAMUS4(I-1,4)-HAAMUS4(I-1,3))
        HIGHBOUND=HAAMUS4(I,3)+(dsqrt(MH0(1))-2d0)/(3.55d0-2d0)
     .         *(HAAMUS4(I,4)-HAAMUS4(I,3))
       ENDIF

       LIMIT=LOWBOUND
     .    +(MH-HAAMUS4(I-1,1))/(HAAMUS4(I,1)-HAAMUS4(I-1,1))
     .         *(HIGHBOUND-LOWBOUND)
       PROB(52)=PROB(52)
     .          +DDIM(SMXS_J_8TeV*CJ2BRHTOAA*BRMM(1)**2/LIMIT,1d0)
      ENDIF

        ENDDO

      RETURN

      END