*------------- Telecommunications & Signal Processing Lab --------------
*                          McGill University
*
*
* Module:
*     REAL FUNCTION DMCINE (DXR, DXRR, DYR, DYRR)
*
*
* Purpose:
*     Calculate a derivative for a cubic at an end point
*
*
* Description:
*     This routine calculates a derivative value that can be used to
*     generate piecewise monotone cubic hermite interpolants.  Consider
*     three points (x0,y0), (x1,y1) and (x2,y2), where x0 < x1 < x2.
*     The derivative is calculated at the point (x0,y0).
*
*
* Parameters:
* R <-  DMCINE - Output derivative value at the reference point
*
* R ->  DXR    - Increment in abscissa value to the right of the
*                reference point (x1-x0, must be positive)
* R ->  DXRR   - Increment in abscissa value to the far right of the
*                reference point (x2-x1, must be positive)
* R ->  DYR    - Increment in ordinate value to the right (y1-y0)
* R ->  DYRR   - Increment in ordinate value to the far right (y2-y1)
*
*
* Author / revision:
*     P. Kabal
*     $Revision: 1.4 $  $Date: 1995/03/08 15:25:30 $
*
*
*-----------------------------------------------------------------------

      REAL FUNCTION DMCINE (DXR, DXRR, DYR, DYRR)


      REAL DXR,DXRR,DYR,DYRR
      REAL SR,SRR


* Check for increasing X values
      IF (DXR.LT.0.0 .OR. DXRR.LT.0.0)
     -  CALL HALT('DMCINE - Abscissa values not in '//
     -            'increasing order')


* SR is the slope to the right of point 0
* SRR is the slope to the far right of point 0
      SR=DYR/DXR
      SRR=DYRR/DXRR

* Set the derivative using a non-centered three-point formula,
* adjusted to be shape-preserving
*
*                                        x1-x0
*   d = a Sr + (1-a) Srr , where a = 1 + ----- .
*                                        x2-x0
*
* The factor a modifies the formula to take into account the
* relative spacing of the values (a varies from 2 to 1). This
* value may have to be modified to preserve monotonicity.
      DMCINE=SR*((DXRR+DXR+DXR)/(DXRR+DXR))
     -     - SRR*(DXR/(DXRR+DXR))
      IF ((DMCINE.GE.0.0 .AND. SR.LE.0.0) .OR.
     -    (DMCINE.LE.0.0 .AND. SR.GE.0.0)) THEN
        DMCINE=0.0
      ELSE IF ((SR.GT.0.0 .AND. SRR.LT.0.0) .OR.
     -         (SR.LT.0.0 .AND. SRR.GT.0.0)) THEN
        IF (ABS(DMCINE).GT.ABS(3.*SR)) DMCINE=3.*SR
      END IF


      RETURN

      END
