      SUBROUTINE MONTE_CARLO_ELEMENTS(NSAMPLE,ELEMENTS,ERROR)
C----------------------------------------------------------------------
C ORBIT 
C       Generate requested number of montecarlo orbital elements 
C Arguments :
C       NSAMPLE  I       Number of requested element sets      Input
C       ELEMENTS R*8(*)  Montecarlo orbital elements           Output
C       ERROR    L       Logical error flag                    Output
C-----------------------------------------------------------------------------
      INCLUDE 'constant.inc'
      INTEGER NSAMPLE
      REAL*8 ELEMENTS(MA,NSAMPLE)
      LOGICAL ERROR
*
      INCLUDE 'elements.inc'
      INCLUDE 'data.inc'
*
      REAL*8  EL_SAVE(MA)      ! Fitted values of elements
      INTEGER I,J,MITER
      LOGICAL QUIET,UPDATE,WARNING
      LOGICAL SIC_CTRLC
*
      QUIET  = .TRUE.
      UPDATE = .FALSE.
      MITER = 20
      CALL SAVE_DATA
      DO I=1,MA
         EL_SAVE(I) = EL(I)
      ENDDO
*
      DO J=1,NSAMPLE
         IF (SIC_CTRLC()) GOTO 99
* Refresh the internal set of orbital elements and generate montecarlo data
         CALL INIT_KEPLER(EL_SAVE,.FALSE.)
         CALL GENERATE_DATA(1,NVR,1,NVCORR,1,NN,1,NPARA,ERROR)
         IF (ERROR) GOTO 99
* Fit the new data
         DO I=1,MA
            ELEMENTS(I,J) = EL_SAVE(I)
         ENDDO
         CALL DO_FIT(MITER,ELEMENTS(1,J),UPDATE,QUIET,WARNING,ERROR)
         IF (ERROR) ERROR = .FALSE.  ! Some samplings may fail to converge
         IF (MOD(J,50).EQ.0)
     +        WRITE(6,*) J,' montecarlo samples generated'
      ENDDO
      CALL RESTORE_DATA
      RETURN
*
 99   ERROR = .TRUE.
      RETURN
      END

      SUBROUTINE SAVE_DATA
C-------------------------------------------------------------------------
C ORBIT: Copy all data to an auxiliary array, so that the main data
C array can be used during the montecarlo error estimation
C-------------------------------------------------------------------------
*
      INCLUDE 'constant.inc'
      INCLUDE 'data.inc'
*
      INTEGER I,J
* Radial velocities
      DO J=1,5
         DO I=1,NVR
            VR_SAVE(I,J) = VR(I,J)
         ENDDO
      ENDDO
* Visual orbit
      DO J=1,7
         DO I=1,NN
            OBS_SAVE(I,J) = OBS(I,J)
         ENDDO
      ENDDO
* Correlation profile
      DO J=1,MVCORR
         DO I=1,NVPNTS(J)
            VCORR_SAVE(I,J) = VCORR(I,J)
         ENDDO
      ENDDO
* Parallaxes
      DO I=1,NPARA
         PAR_SAVE(I) = PARALLAX(I)
      ENDDO
      RETURN
      END

      SUBROUTINE RESTORE_DATA
C-------------------------------------------------------------------------
C ORBIT: Restore all data from auxiliary arrays, after the main data
C array have been overwritten during the montecarlo error estimation
C-------------------------------------------------------------------------
*
      INCLUDE 'constant.inc'
      INCLUDE 'data.inc'
*
      INTEGER I,J
* Radial velocities
      DO J=1,5
         DO I=1,NVR
            VR(I,J) = VR_SAVE(I,J) 
         ENDDO
      ENDDO
* Visual orbit
      DO J=1,7
         DO I=1,NN
            OBS(I,J) = OBS_SAVE(I,J) 
         ENDDO
      ENDDO
* Correlation profile
      DO J=1,MVCORR
         DO I=1,NVPNTS(J)
            VCORR(I,J) = VCORR_SAVE(I,J) 
         ENDDO
      ENDDO
* Parallaxes
      DO I=1,NPARA
         PARALLAX(I) = PAR_SAVE(I) 
      ENDDO
      RETURN
      END

      SUBROUTINE GENERATE_DATA(FIRST_VR,N_VR,FIRST_VCORR,
     +     N_VCORR,FIRST_VIS,N_VIS,FIRST_PARA,N_PARA,ERROR)
C-------------------------------------------------------------------------
C ORBIT: Generate trial data for one montecarlo step
C-------------------------------------------------------------------------
      INTEGER FIRST_VR,N_VR,FIRST_VCORR,N_VCORR,FIRST_VIS,
     +     N_VIS,FIRST_PARA,N_PARA
      LOGICAL ERROR
      INCLUDE 'constant.inc'
      INCLUDE 'data.inc'
      INCLUDE 'elements.inc'
      INCLUDE 'pi.inc'
*
      INTEGER I
      REAL B(MA),V,PHASE,RHO,THETA,XX,YY,POS,CPOS,SPOS
      REAL PAR
      REAL RANGAU
*
* Radial velocity data
      DO I=FIRST_VR,FIRST_VR+N_VR-1
         CALL SET_TIME(1,IORB0,VR(I,I_TIME),PHASE)
         IF (CVR(I).EQ.'2') THEN
            CALL GRAD_V2(VREFCODE(I),V,B)
         ELSEIF (CVR(I).EQ.'1') THEN
            CALL GRAD_V1(VREFCODE(I),V,B)
            IF (V.NE.V) THEN
               write(6,*) 'Estimated Velocity ',V
            ENDIF
         ELSEIF (CVR(I).EQ.'11') THEN
            CALL GRAD_V11(VREFCODE(I),V,B)
         ELSEIF (CVR(I).EQ.'12') THEN
            CALL GRAD_V12(VREFCODE(I),V,B)
         ELSEIF (CVR(I).EQ.'21') THEN
            CALL GRAD_V21(VREFCODE(I),V,B)
         ELSEIF (CVR(I).EQ.'22') THEN
            CALL GRAD_V22(VREFCODE(I),V,B)
         ELSE
            WRITE(6,*) 'Unknown velocity type: ',CVR(I)
         ENDIF
         VR(I,I_VR) = V+SIG*RANGAU(SNGL(VR(I,I_S_VR)))
      ENDDO
* 
      DO I=FIRST_VCORR,FIRST_VCORR+N_VCORR-1
         CALL GENERATE_VCORR(I,ERROR)
         IF (ERROR) GOTO 99 
      ENDDO

      DO I=FIRST_VIS,FIRST_VIS+N_VIS-1
         CALL SET_TIME(1,IORB0,OBS(I,I_TIME),PHASE)
         IF (COBS(I).EQ.'rho-theta') THEN ! Rho+Theta pair
            CALL KEPLER_RHOTHETA(RHO,THETA)
            OBS(I,I_RHO)   = RHO+SIG*RANGAU(SNGL(OBS(I,I_S_RHO)))
            OBS(I,I_THETA) = THETA+SIG*RANGAU(SNGL(OBS(I,I_S_THETA)))
         ELSEIF (COBS(I).EQ.'PROJ') THEN ! Projected separation
            CALL KEPLER_XY(XX,YY)
            POS = (90-OBS(I,I_POSANG))/GR! Astro PA to trigonometric convention
            CPOS=COS(POS)
            SPOS=SIN(POS)
            OBS(I,I_PROJ) = XX*CPOS+YY*SPOS+
     +           SIG*RANGAU(SNGL(OBS(I,I_S_PROJ)))
         ELSEIF (COBS(I).EQ.'XY')  THEN ! X+Y pairs
            CALL KEPLER_XY(XX,YY)
            OBS(I,I_X) = XX+SIG*RANGAU(SNGL(OBS(I,I_S_X)))
            OBS(I,I_Y) = YY+SIG*RANGAU(SNGL(OBS(I,I_S_Y)))
         ELSEIF (COBS(I).EQ.'ZT') THEN
            CALL KEPLER_XY(XX,YY)
            OBS(I,I_Z) = (XX+YY)/SQRT(2.)+SIG*RANGAU(SNGL(OBS(I,I_S_Z)))
            OBS(I,I_T) = (YY-XX)/SQRT(2.)+SIG*RANGAU(SNGL(OBS(I,I_S_T)))
         ENDIF
      ENDDO
*
      DO I=FIRST_PARA,FIRST_PARA+N_PARA-1
         CALL GRAD_PARALLAX(PAR,B)
         PARALLAX(I) = PAR+SIG*RANGAU(PARERR(I))
      ENDDO

      RETURN
*
 99   ERROR = .TRUE.
      RETURN
      END


      SUBROUTINE GENERATE_VCORR(ICOR,ERROR)
      INTEGER ICOR
      LOGICAL ERROR
*
      INCLUDE 'constant.inc'
      INCLUDE 'data.inc'
      INCLUDE 'elements.inc'
      INCLUDE 'control.inc'
*
      REAL RANGAU
      INTEGER J
*
* Request the model profile on observing date date of true profile ICOR, 
* with all components in,
* 
      CALL GET_MODEL_PROFILE(ICOR,1,0,.TRUE.,
     +     PROFILE_METHOD.EQ.'CORRECTED',
     +     NVPNTS(ICOR),
     +     COR_REFPIX(ICOR),COR_REFVAL(ICOR),COR_VSTEP(ICOR),
     +     VCORR(1,ICOR),ERROR)
* Add gaussian noise
      DO J=1,NVPNTS(ICOR)
         VCORR(J,ICOR) = VCORR(J,ICOR)+SIG*RANGAU(COR_SIGM(ICOR))
      ENDDO
      RETURN
      END
