      SUBROUTINE GET_GRADVEL(TIME,ICOMP,REFCODE,VEL,B,ERROR)
C----------------------------------------------------------------------------
* Returns the radial velocity of one specified component at requested time
* and its gradient relative to the various orbital elements.
* This is basically a long 'case' statement that branches to the apropriate
* specific routines for each component. No actual calculation is done here.
*
** FIXME: Should be consolidated with GET_VELOCITY
C------------------------------------------------------------------------------
      REAL*8 TIME
      INTEGER ICOMP, REFCODE
      REAL*4 VEL, B(*)
      LOGICAL ERROR
*
      INCLUDE 'constant.inc'
*
      REAL PHASE
*
      CALL SET_TIME(1,IORB0,TIME,PHASE) ! Always needed...
      IF (ICOMP.EQ.1) THEN
         CALL GRAD_V1(REFCODE,VEL,B)
      ELSEIF (ICOMP.EQ.2) THEN
         CALL GRAD_V2(REFCODE,VEL,B)
      ELSEIF (ICOMP.EQ.11.OR.ICOMP.EQ.12) THEN
         CALL SET_TIME(1,IORB1,TIME,PHASE)
         IF (ICOMP.EQ.11) THEN
            CALL GRAD_V11(REFCODE,VEL,B)
         ELSEIF (ICOMP.EQ.12) THEN
            CALL GRAD_V12(REFCODE,VEL,B)
         ENDIF
      ELSEIF (ICOMP.EQ.21.OR.ICOMP.EQ.22) THEN
         CALL SET_TIME(1,IORB2,TIME,PHASE)
         IF (ICOMP.EQ.21) THEN
            CALL GRAD_V21(REFCODE,VEL,B)
         ELSEIF (ICOMP.EQ.22) THEN
            CALL GRAD_V22(REFCODE,VEL,B)
         ENDIF
      ELSE
         WRITE(6,*) 'E-VISU,  Unknown component ',ICOMP
         GOTO 99
      ENDIF
      IF (VEL.NE.VEL) THEN ! Check for NaNs
         WRITE(6,101) 'E-VELOCITY, Error evaluating velocity for ',
     +        'component ',ICOMP
         WRITE(6,101) 'E-VELOCITY, Velocity is Not a Number '
 101     FORMAT(1X,A,A,I2)
         GOTO 99  
      ENDIF
      RETURN
*
 99   ERROR = .TRUE.
      RETURN
      END
*
      SUBROUTINE GET_VELOCITY(TIME,ICOMP,REFCODE,VEL,ERROR)
* Returns the radial velocity of one specified component at requested time.
* This is basically a long 'case' statement that branches to the apropriate
* specific routines for each component. No actual calculation is done here.
      REAL*8 TIME
      INTEGER ICOMP,REFCODE
      REAL*4 VEL
      LOGICAL ERROR
*
      INCLUDE 'constant.inc'
*
      REAL V1,V2,PHASE,B(MA)
*
      CALL SET_TIME(1,IORB0,TIME,PHASE)
      IF (ICOMP.EQ.1.OR.ICOMP.EQ.2) THEN
         CALL VALUE_V1_V2(REFCODE,V1,V2)
         IF (ICOMP.EQ.1) THEN
            VEL = V1
         ELSEIF (ICOMP.EQ.2) THEN
            VEL = V2
         ENDIF
      ELSEIF (ICOMP.EQ.11.OR.ICOMP.EQ.12) THEN
         CALL SET_TIME(1,IORB1,TIME,PHASE)
         IF (ICOMP.EQ.11) THEN
            CALL GRAD_V11(REFCODE,VEL,B)
         ELSEIF (ICOMP.EQ.12) THEN
            CALL GRAD_V12(REFCODE,VEL,B)
         ENDIF
      ELSEIF (ICOMP.EQ.21.OR.ICOMP.EQ.22) THEN
         CALL SET_TIME(1,IORB2,TIME,PHASE)
         IF (ICOMP.EQ.21) THEN
            CALL GRAD_V21(REFCODE,VEL,B)
         ELSEIF (ICOMP.EQ.22) THEN
            CALL GRAD_V22(REFCODE,VEL,B)
         ENDIF
      ELSE
         WRITE(6,*) 'E-VISU,  Unknown component ',ICOMP
         GOTO 99
      ENDIF
      IF (VEL.NE.VEL) THEN ! Check for NaNs
         WRITE(6,101) 'E-VELOCITY, Error evaluating velocity for ',
     +        'component ',ICOMP
         WRITE(6,101) 'E-VELOCITY, Velocity is Not a Number '
 101     FORMAT(1X,A,A,I2)
         GOTO 99  
      ENDIF
      RETURN
*
 99   ERROR = .TRUE.
      RETURN
      END
*
      SUBROUTINE VALUE_V1_V2(CODE,V1,V2)
* Returns radial velocity values for the outer orbit
      REAL V1,V2
      INTEGER CODE
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
      REAL DELTA
* Call basic keplerian orbit routine for the outer orbit.
      CALL KEPLER_RV(IORB0,V1,V2)
* Add the systemic velocity
      V1=V0+V1
      V2=V0+V2
* Add apropriate instrumental zero point correction when needed
      IF (CODE.LT.1.OR.CODE.GT.MVREF) write(6,*) 'ERROR, CODE:',code
      IF (CODE.GT.1) THEN
         DELTA = DV(CODE-1)
         V1=V1+DELTA
         V2=V2+DELTA
      ENDIF
* Add the gravitational+convective velocity shift for each component.
      V1=V1+DELTV(1,IORB0)
      V2=V2+DELTV(2,IORB0)
      RETURN
      END
*
*
      SUBROUTINE GRAD_V1(CODE,V1,B)
C B(j)=dV1/dEL(j), RES1=V1
      INTEGER CODE
      REAL V1,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
*
      INTEGER I
      REAL DELTA
*
      DO I=1,MA
         B(I)=0
      ENDDO
*
* Call keplerian radial velocity gradient routine for the outer orbit 
      CALL GRAD_VA(IORB0,V1,B)
* Add systemic velocity, and set the corresponding gradient element to +1
      V1   = V0+V1
      B(I_V0)= +1.
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1
      V1 = V1 + DELTV(1,IORB0)
      B(I_DELTV1+ELINDX(IORB0)) = +1
* Add radial velocity zero point, and the set corresponding gradient element
* to +1
      IF (CODE.LT.1.OR.CODE.GT.MVREF) write(6,*) 
     +     'INTERNAL ERROR, CODE:',code
      IF (CODE.GT.1) THEN
         DELTA = DV(CODE-1)
         V1 = V1+DELTA
         B(MELEM+CODE-1) = +1.
      ENDIF
*
      RETURN
      END
*
      SUBROUTINE GRAD_V2(CODE,V2,B)
C B(j)=dV2/dEL(j), RES2=V2
      INTEGER CODE
      REAL V2,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
*
      INTEGER I
      REAL DELTA
*
      DO I=1,MA
         B(I)=0
      ENDDO
*
* Call keplerian radial velocity gradient routine for the outer orbit 
      CALL GRAD_VB(IORB0,V2,B)
* Add systemic velocity, and set the corresponding gradient element to +1
      V2   = V0+V2
      B(I_V0)= +1.
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1
      V2 = V2 + DELTV(2,IORB0)
      B(I_DELTV2+ELINDX(IORB0)) = +1
* Add radial velocity zero point, and the set corresponding gradient element
* to +1
      IF (CODE.LT.1.OR.CODE.GT.MVREF) write(6,*) 'ERROR, CODE:',code
      IF (CODE.GT.1) THEN
         DELTA = DV(CODE-1)
         V2 = V2+DELTA
         B(MELEM+CODE-1) = +1.
      ENDIF
*
      RETURN
      END
C<FF>
      SUBROUTINE GRAD_V11(CODE,V11,B)
C B(j)=dV11/dEL(j), RES1=V11
      INTEGER CODE
      REAL V11,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
      REAL V1
*
* Call full gradient routine of the outer orbit
      CALL GRAD_V1(CODE,V1,B)
*
* Call keplerian gradient routine for the inner orbit 
      CALL GRAD_VA(IORB1,V11,B) ! B(ELINDX(IORB1)))

* Add the two components of V11: V11(Hel) = V1(Hel)+V11(1)
* As there is no overlap of orbital elements, there is no need
* for an explicit sum on the gradient, the two parts are just
* evaluated in place. CAUTION: this would not longer be true
* for a sel of physical+geometric elements.
      V11 = V11+V1
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1. 
      V11 = V11 + DELTV(1,IORB1)
      B(I_DELTV1+ELINDX(IORB1)) = +1
*
      RETURN
      END
C<FF>
      SUBROUTINE GRAD_V12(CODE,V12,B)
C B(j)=dV12/dEL(j), RES1=V12
      INTEGER CODE
      REAL V12,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
      REAL V1
*
* Call full gradient routine of the outer orbit
      CALL GRAD_V1(CODE,V1,B)
*
* Call keplerian gradient routine for the inner orbit 
      CALL GRAD_VB(IORB1,V12,B) ! B(ELINDX(IORB1)))
* Add the two components of V12: V12(Hel) = V1(Hel)+V12(1)
* As there is no overlap of orbital elements, there is no need
* for an explicit sum on the gradient, the two parts are just
* evaluated in place.
      V12 = V12+V1
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1. 
      V12 = V12 + DELTV(2,IORB1)
      B(I_DELTV2+ELINDX(IORB1)) = +1
*
      RETURN
      END
C<FF>
      SUBROUTINE GRAD_V21(CODE,V21,B)
C B(j)=dV21/dEL(j), RES1=V21
      INTEGER CODE
      REAL V21,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
      REAL V2
*
* Call full gradient routine of the outer orbit
      CALL GRAD_V2(CODE,V2,B)
*
* Call keplerian gradient routine for the inner orbit 
      CALL GRAD_VA(IORB2,V21,B) ! B(ELINDX(IORB2)))

* Add the two components of V21: V21(Hel) = V2(Hel)+V21(1)
* As there is no overlap of orbital elements, there is no need
* for an explicit sum on the gradient, the two parts are just
* evaluated in place.
      V21 = V21+V2
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1. 
      V21 = V21 + DELTV(1,IORB2)
      B(I_DELTV1+ELINDX(IORB2)) = +1
*
      RETURN
      END
C<FF>
      SUBROUTINE GRAD_V22(CODE,V22,B)
C B(j)=dV22/dEL(j), RES1=V22
      INTEGER CODE
      REAL V22,B(*)
*
      INCLUDE 'constant.inc'
      INCLUDE 'kepler.inc'
      REAL V2
*
* Call full gradient routine of the outer orbit
      CALL GRAD_V2(CODE,V2,B)
*
* Call keplerian gradient routine for the inner orbit 
      CALL GRAD_VB(IORB2,V22,B) ! B(ELINDX(IORB2)))
* Add the two components of V22: V22(Hel) = V2(Hel)+V22(1)
* As there is no overlap of orbital elements, there is no need
* for an explicit sum on the gradient, the two parts are just
* evaluated in place.
      V22 = V22+V2
* Add grav+conv velocity shift, and set the corresponding gradient element 
* to +1. 
      V22 = V22 + DELTV(2,IORB2)
      B(I_DELTV2+ELINDX(IORB2)) = +1
*
*
      RETURN
      END


