      SUBROUTINE ORBIT_OPTIMISE(LINE,ERROR)
      USE GKERNEL_INTERFACES
      CHARACTER LINE*(*)
      LOGICAL ERROR
*      
      INCLUDE 'constant.inc'
      INCLUDE 'data.inc'
      INCLUDE 'pi.inc'
*     
!      INCLUDE 'interface.inc'
*
      INTEGER MVOCAB,ID
      PARAMETER (MVOCAB=4)
      CHARACTER*12 VOCAB(MVOCAB),ARGUM,DATE
      CHARACTER NAME,OUT_FILE*80
      INTEGER NKEY,NCH,OUTLUN,NF,STATUS
      REAL DURATION
*
      INTEGER NVSB1,NVSB2,NXY
      REAL JDMIN,JDMAX,SIGVSB1,SIGVSB2A,SIGVSB2B,SIGXY
      CHARACTER TARGET*16
      REAL XBEST(MVR+MOBS),YBEST
      LOGICAL STORE
*
      DATA VOCAB /'MASS_A','MASS_B','MASS_TOT','PARALLAX'/
* Determine requested action type from command line
      ERROR = .FALSE.
      ARGUM = 'MASS_B'
      CALL SIC_CH (LINE,0,1,ARGUM,NCH,.FALSE.,ERROR)
      IF (ERROR) RETURN
      CALL SIC_AMBIGS('OPTIMISE',ARGUM,TARGET,NKEY,VOCAB,
     +     MVOCAB,ERROR)
      IF (ERROR) RETURN
* Should simulated data be kept in data arrays?
      STORE = SIC_PRESENT(6,0)
* Determine observing interval limits
      CALL SIC_R4 (LINE,1,1,DURATION,.TRUE.,ERROR) ! Could default to period??
      IF (ERROR) RETURN
      IF (DURATION.LE.0) THEN
         WRITE(6,*) 'E-OPTIMISE, Invalid duration of observing period.',
     +        ' Must be positive.',DURATION
         GOTO 100
      ENDIF
      IF (.NOT.SIC_PRESENT(1,2)) THEN ! Default to current date
         CALL SIC_DATE(DATE)
         CALL CDATE(DATE,ID,ERROR)
         JDMIN = ID+60549.5D0
      ELSE 
         CALL SIC_R4 (LINE,1,2,JDMIN,.TRUE.,ERROR)
      ENDIF
      JDMAX = JDMIN+DURATION
* Retrieve number of radial velocity measurements and their accuracy
      NVSB1 = 0
      IF (SIC_PRESENT(2,0)) THEN
         CALL SIC_I4 (LINE,2,1,NVSB1,.TRUE.,ERROR)
         IF (ERROR) GOTO 100
         IF (NVSB1.LT.0) THEN
            WRITE(6,*) 'E-OPTIMISE, Invalid number of single ',
     +           'line radial velocity measurements. ',
     +           'Must be positive.', NVSB1
            GOTO 100
         ENDIF
         CALL SIC_R4 (LINE,2,2,SIGVSB1,.TRUE.,ERROR)
         IF (ERROR) GOTO 100
         IF (SIGVSB1.LE.0) THEN
            WRITE(6,*) 'E-OPTIMISE, Invalid standard error for ',
     +           'single line radial velocities. Must be positive.'
     +           , SIGVSB1
            GOTO 100
         ENDIF
      ENDIF
      NVSB2 = 0
      IF (SIC_PRESENT(3,0)) THEN
         CALL SIC_I4 (LINE,3,1,NVSB2,.TRUE.,ERROR)
         IF (ERROR) GOTO 100
         IF (NVSB2.LT.0) THEN
            WRITE(6,*) 'E-OPTIMISE, Invalid number of double ',
     +           'line radial velocity measurements. ',
     +           'Must be positive.', NVSB2
            GOTO 100
         ENDIF
         CALL SIC_R4 (LINE,3,3,SIGVSB2B,.TRUE.,ERROR)
         IF (ERROR) RETURN
         CALL SIC_R4 (LINE,3,2,SIGVSB2A,.TRUE.,ERROR)
         IF (ERROR) RETURN
         IF (SIGVSB2A.LE.0.OR.SIGVSB2B.LE.0) THEN
            WRITE(6,*) 'E-OPTIMISE, Invalid standard error for ',
     +           'double line radial velocities. Must both be positive.'
     +           , SIGVSB2A, SIGVSB2B
            GOTO 100
         ENDIF
      ENDIF
      IF ((NVSB1+2*NVSB2+NVR).GT.MVR) THEN
         WRITE(6,*) 'E-OPTIMISE,  Too many radial velocities for ',
     +        'current program dimensions'
         GOTO 100
      ENDIF
* Retrieve number of angular separation measurements and their accuracy
      NXY = 0
      IF (SIC_PRESENT(4,0)) THEN
         CALL SIC_I4 (LINE,4,1,NXY,.TRUE.,ERROR)
         IF (ERROR) RETURN
         IF ((NXY+NN).GT.MOBS) THEN
            WRITE(6,*) 'E-OPTIMISE,  Too many visual measurements for ',
     +           'current program dimensions'
            GOTO 100
         ELSEIF (NXY.LT.0) THEN
            WRITE(6,*) 'E-OPTIMISE,  Invalid number of visual ',
     +           'measurements. Must be positive ',NXY
            GOTO 100
         ELSE
            CALL SIC_R4 (LINE,4,2,SIGXY,.TRUE.,ERROR)
            IF (ERROR) RETURN
         ENDIF
      ENDIF
* Ouput listing name (default to stdout)
      IF (SIC_PRESENT(5,0)) THEN
         CALL SIC_CH(LINE,5,1,NAME,NF,.TRUE.,ERROR)
         IF (ERROR) GOTO 100
         STATUS= SIC_GETLUN(OUTLUN)
         IF (STATUS.NE.0) THEN
            WRITE(6,*) 'E-OPTIMISE,  Cannot open file ',
     +           OUT_FILE(1:LENC(OUT_FILE))
            CALL SIC_FRELUN(OUTLUN)
            GOTO 100
         ENDIF
         CALL SIC_PARSEF(NAME(1:NF),OUT_FILE,' ','.LIS')
         OPEN(UNIT=OUTLUN,FILE=OUT_FILE,STATUS='UNKNOWN',
     +        IOSTAT=STATUS)
         IF (STATUS.NE.0) THEN
            WRITE(6,*) 'E-LIST,  Cannot open file ',
     +           OUT_FILE(1:LENC(OUT_FILE))
            CALL SIC_FRELUN(OUTLUN)
            GOTO 100
         ENDIF
      ELSE
         OUTLUN = 6
      ENDIF
*
      WRITE(6,*) 'W-OPTIMISE,  Work on this command is still ',
     +     'going on. Not yet fully tested. '
*
* Command line has been decoded, call the subroutine that makes the actual
* work.
      CALL DO_OPTIMISE(TARGET,JDMIN,JDMAX,NVSB1,NVSB2,NXY,SIGVSB1,
     +     SIGVSB2A,SIGVSB2B,SIGXY,XBEST,YBEST,ERROR)
      IF (ERROR) GOTO 90
* Printout the optimised schedule, and resulting errors on all parameters
      CALL PRINT_BEST_SCHEDULE(OUTLUN,NVSB1,NVSB2,NXY,
     +     TARGET,YBEST,XBEST,ERROR)
      IF (ERROR) GOTO 100
*
* Cleanup
 90   CONTINUE
      IF (OUTLUN.NE.6) THEN
         CLOSE(OUTLUN)
         CALL SIC_FRELUN(OUTLUN)
      ENDIF
      IF (.NOT.ERROR.AND.STORE) THEN
         NN  = NN+NXY
         NVR = NVR+NVSB1+2*NVSB2
      ENDIF
      RETURN
*
 100  ERROR = .TRUE.
      RETURN
      END

      SUBROUTINE DO_OPTIMISE(TARGET,JDMIN,JDMAX,NVSB1,NVSB2,NXY,SIGVSB1,
     +     SIGVSB2A,SIGVSB2B,SIGXY,XBEST,YBEST,ERROR)
C-----------------------------------------------------------------------------
C Orbit:
C   Observing schedule optimisation. Make the actual work.
C Arguments:
C   TARGET  C     Minimised function
C   JDMIN   R     Start of observing interval
C   JDMAX   R     End of observing interval
C   NVSB1   R     Number of single line radial velocity measurements
C   NVSB2   R     Number of double line radial velocity measurements
C   NXY     R     Number of visual measurements
C   SIGVSB1 R     Standard error of single line radial velocity measurements
C   SIGVSB2A R    Standard error for first component in double line measurements
C   SIGVSB2B R    Standard error for second component in double line measurements
C   SIGXY   R     Standard error for angular separation measurements
C   XBEST   R(*)  Optimal set of additional observing dates
C   YBEST   R     Optimal value of parameter
C   ERROR   L     Error flag
C-----------------------------------------------------------------------------
      REAL JDMIN,JDMAX,SIGVSB1,SIGVSB2A,SIGVSB2B,SIGXY
      INTEGER NVSB1,NVSB2,NXY
      REAL XBEST(*),YBEST
      CHARACTER*(*) TARGET
      LOGICAL ERROR
*
      INCLUDE 'constant.inc'
      INCLUDE 'optimise.inc'
      INCLUDE 'elements.inc'
      INCLUDE 'pi.inc'
*
      REAL SIMPLEX(MVR+MOBS,MVR+MOBS+1),Y(MVR+MOBS+1)
      REAL TEMPTR,FTOL
      INTEGER ITER,MITER
      REAL GAG_RANDOM,DURATION
      INTEGER I,J
      REAL ERREUR_FUNCT
      EXTERNAL ERREUR_FUNCT
* 
* Initialise internal set of orbital elements
      CALL INIT_KEPLER(EL,.TRUE.)
* Copy control parameters to internal common block, for use by optimised
* function.
      OPT_TARGET = TARGET
      OPT_JDMIN = JDMIN
      OPT_JDMAX = JDMAX
      OPT_NV_SB1 = NVSB1
      OPT_NV_SB2 = NVSB2
      OPT_NXY = NXY
      OPT_SIGV_SB1 = SIGVSB1
      OPT_SIGV_SB2A = SIGVSB2A
      OPT_SIGV_SB2B = SIGVSB2B
      OPT_SIGXY = SIGXY
* Initialise the schedule simplex with a random distribution.
      NDIM = OPT_NV_SB1+OPT_NV_SB2+OPT_NXY
      DURATION = OPT_JDMAX-OPT_JDMIN
      DO J=1,NDIM+1
         DO I=1,NDIM
            SIMPLEX(I,J) = OPT_JDMIN+DURATION*GAG_RANDOM()
         ENDDO
         Y(J) = ERREUR_FUNCT(SIMPLEX(1,J))
      ENDDO
      DO I=1,NDIM
         XBEST(I) = SIMPLEX(I,1) 
      ENDDO
      YBEST = Y(1)
      MITER = 500
      TEMPTR = 0   ! No annealing for the time being
      FTOL = 1.E-2 ! Assume this means practical convergence
*
      ITER = MITER
      CALL AMEBSA(SIMPLEX,Y,MVR+MOBS,MVR+MOBS+1,NDIM,XBEST,
     +     YBEST,FTOL,ERREUR_FUNCT,ITER,TEMPTR,ERROR)
*
      RETURN
* Reset orbital elements??? Looks weird, never reached.
!      CALL INIT_KEPLER(EL,.FALSE.)
      END

      SUBROUTINE PRINT_BEST_SCHEDULE(LUN,NSB1,NSB2,NXY,TARGET,
     +     YBEST,PBEST,ERROR)
      USE GKERNEL_INTERFACES
C--------------------------------------------------------------------------
C Orbit:
c   Readable printout of the optimised observing schedule.
C Arguments:
C     LUN     I       Logical unit for output
C     NSB1    I       Number of single line radial velocity measurements
C     NSB2    I       Number of double line radial velocity measurements
C     NXY     I       Number of angular separation measurements
C     TARGET  C*(*)   Optimised parameter
C     YBEST   R       Best error on target parameter
C     PBEST   R*4()   Observing dates of the optimal schedule
C--------------------------------------------------------------------------
      INTEGER LUN,NSB1,NSB2,NXY
      CHARACTER*(*) TARGET
      REAL YBEST
      REAL PBEST(NSB1+NSB2+NXY)
*
      INCLUDE 'constant.inc'
      INCLUDE 'elements.inc'
      INCLUDE 'pi.inc'
      INTEGER IT(MVR+MOBS)

      INTEGER I
      REAL PHASE
      REAL*8 TT
      LOGICAL ERROR
      CHARACTER CHAIN*17
*
      REAL Mtot,M_A,M_B,dMtot,dM_A,dM_B 
      REAL a1Sini, a2Sini   ! Projected semi major axes
      REAL f1m, f2m         ! Mass functions
      REAL M1sin3i, M2sin3i   ! "projected masses"
      REAL dM1sin3i, dM2sin3i ! and their standard errors
      REAL Orb_Par,dOrb_Par ! Orbital parallax and probable error
      REAL V1,V2,dV1,dV2
      REAL RHO,THETA,dRHO,dTHETA
      REAL B(MA)
      REAL ERREUR_FUNCT, DUMMY
*
      WRITE(LUN,90) 'Best error on ',TARGET(1:LENC(TARGET)),
     +     ' was:',100*YBEST,'%'
 90   FORMAT(1X,A,A,A,1X,F4.1,A)
* Reset orbital elements to compute ephemerid
      CALL INIT_KEPLER(EL,.FALSE.)
*
* Single line spectroscopic observations
      IF (NSB1.GT.0) THEN
         CALL GR4_TRIE(PBEST(1:),IT,NSB1,ERROR)  ! Sort by observing date
         WRITE(LUN,*) 'For SB1 observations on '
         DO I=1,NSB1
            TT = PBEST(I)
            CALL FORMAT_DATE(TT,CHAIN,ERROR)
            CALL SET_TIME(1,IORB0,TT,PHASE)
            CALL GRAD_V1(1,V1,B)  ! Assume main velocity referential
            CALL EVAL_ERROR(dV1,B)
            WRITE(LUN,100) PBEST(I),CHAIN,PHASE,V1,dV1
         ENDDO
      ENDIF
  100  FORMAT(1X,F9.3,1X,A,1X,F5.3,(F7.1,'(',F4.1,')'))
*
* Double line spectroscopic observations
      IF (NSB2.GT.0) THEN
         CALL GR4_TRIE(PBEST(NSB1+1:),IT,NSB2,ERROR)  ! Sort by observing date
         WRITE(LUN,*) 'For SB2 observations on '
         DO I=NSB1+1,NSB1+NSB2
            TT = PBEST(I)
            CALL FORMAT_DATE(TT,CHAIN,ERROR)
            CALL SET_TIME(1,IORB0,TT,PHASE)
            CALL GRAD_V1(1,V1,B)
            CALL EVAL_ERROR(dV1,B)
            CALL GRAD_V2(1,V2,B)
            CALL EVAL_ERROR(dV2,B)
            WRITE(LUN,110) PBEST(I),CHAIN,PHASE,V1,dV1,V2,dV2
         ENDDO
      ENDIF
 110  FORMAT(1X,F9.3,1X,A,1X,F5.3,2(F7.1,'(',F4.1,')'))
*
* Visual observations
      IF (NXY.GT.0) THEN
         CALL GR4_TRIE(PBEST(NSB1+NSB2+1:),IT,NXY,ERROR) ! Sort 
         WRITE(LUN,*) 'For visual observations on '
         DO I=NSB1+NSB2+1,NSB1+NSB2+NXY
            TT = PBEST(I)
            CALL FORMAT_DATE(TT,CHAIN,ERROR)
            CALL SET_TIME(1,IORB0,TT,PHASE)
            CALL GRAD_RHO(RHO,B)
            CALL EVAL_ERROR(dRHO,B)
            CALL GRAD_THETA(THETA,B)
            CALL EVAL_ERROR(dTHETA,B)
            dTHETA = dTHETA*GR  ! Convert standard error to degrees
            WRITE(LUN,120) PBEST(I),CHAIN,PHASE,RHO,dRHO,THETA,dTHETA
         ENDDO
      ENDIF
 120  FORMAT(1X,F9.3,1X,A,1X,F5.3,(F5.3,'(',F4.3,')'), 
     +        (F6.1,'(',F3.1,')'))
      WRITE(LUN,*) ' '
* Make sure that the covariance matrix does corresponds to the observing
* schedule. This is important when the optimisation isn't fully converged.
      DUMMY = ERREUR_FUNCT(PBEST) 
*
* Print standard errors on all parameters
      CALL COMPUTE_MASSES(EL,MA,.TRUE.,
     +     a1sini,a2sini,f1m,f2m,
     +     M1sin3i,dM1sin3i,M2sin3i,dM2sin3i,
     +     Mtot,dMtot,M_A,dM_A,M_B,dM_B,
     +     Orb_Par,dOrb_Par,ERROR)
      IF (ERROR) GOTO 99
* Total mass
      WRITE(LUN,400) 'Total Mass =',Mtot,dMtot,100*dMtot/Mtot
 400  FORMAT(A,1X,F6.3,1X,'+-',F6.3,1X,
     +     'Solar masses',1X,'(',F4.1,'%',')')
*     Individual masses
      WRITE(LUN,400) 'Mass A =',M_A,dM_A,100*dM_A/M_A
      WRITE(LUN,400) 'Mass B =',M_B,dM_B,100*dM_B/M_B
*     Orbital parallax
      write(LUN,410) 'Parallax is ',Orb_Par,dOrb_Par,
     +     100*dOrb_Par/Orb_Par
 410  FORMAT(A,F6.4,1X,'+-',F5.4,'"',1X,'(',F4.1,'%)')
      RETURN
*
 99   ERROR = .TRUE.
      RETURN
      END
