C
      SUBROUTINE MONTE(FUNC,XVLO,XVEC,XVHI,NVEC)
C
C Subroutine MONTE: Monte-Carlo minimization of FUNC
C
C Update history:
C    V1.0    Original version                            8-Oct-1992
C
      IMPLICIT NONE
C
C Arguments:
C    FUNC = R*4 function = quantity to minimize
C    XVLO = R*4(1)       = array of lower limits to XVEC
C    XVEC = R*4(1)       = array of quantities to find at minimum
C    XVHI = R*4(1)       = array of upper limits to XVEC
C    NVEC = I*4          = number of parameters
C
      REAL*4    FUNC
      EXTERNAL  FUNC
C
      REAL*4    XVLO(1),XVEC(1),XVHI(1)
      INTEGER*4 NVEC
C
C Subprogrammes:
C    GETOP = subroutine   = get value of optimization control variable
C    RAN   = R*4 function = Sun random number generator
C
      REAL*4   RAN
      EXTERNAL GETOP
C
C Local parameter:
C    NVMAX   = I*4 = maximum size of vectors that can be dealt with
C
      INTEGER*4  NVMAX
      PARAMETER (NVMAX=   128)
C
C Local variables:
C    FMIN    = R*4        = minimum of function
C    FVAL    = R*4        = current function value
C    I1      = I*4        = counting index
C    ILOOP   = I*4        = counter of loops
C    IFLAG   = I*4        = random number generator flag
C    IVEC    = I*4        = index of position in vector
C    NLOOP   = I*4        = number of Monte-Carlo throws to try
C    VALUE   = R*4        = value of variable returned from GETOP
C    XINI(i) = R*4(NVMAX) = initial guess vector
C    XMIN(i) = R*4(NVMAX) = current minimum vector
C
      REAL*4    FMIN,FVAL,XMIN(NVMAX),VALUE
      INTEGER*4 I1,ILOOP,IFLAG,IVEC,NLOOP
C
C Get count of Monte-Carlo attempts
C
      CALL GETOP('MONTE.NLOOP',VALUE)
      NLOOP=IFIX(VALUE+0.5)
C
C Set random number generator flag to zero (give new random number
C    on each call)
C
      IFLAG=0
C
C Check that vector length isn't too large
C
      IF (NVEC .GT. NVMAX) THEN
        WRITE (6,699)
        RETURN
      ENDIF
C
C Get starting value of FUNC, save vector.
C
      FMIN=FUNC(XVEC,NVEC)
      DO I1=1,NVEC
        XMIN(I1)=XVEC(I1)
      ENDDO
C
C Debug:
C
      WRITE (6,999) FMIN
C
C Now, loop over the following NLOOP times. In each loop the variables
C    are assigned within the allowed range.
C
      DO ILOOP=1,NLOOP
C
C For each variable, calculate the corresponding value using a 
C    uniform distribution in XVLO to XVHI. If XVLO=XVHI, then
C    don't bother.
C
        DO IVEC=1,NVEC
          IF (XVLO(IVEC) .NE. XVHI(IVEC)) THEN
            XVEC(IVEC)=XVLO(IVEC)+(XVHI(IVEC)-XVLO(IVEC))*RAN(IFLAG)
          ENDIF
        ENDDO
C
C Get new value of function, save it and the vector if smaller than
C    the previous value.
C
        FVAL=FUNC(XVEC,NVEC)
C
        IF (FVAL .LT. FMIN) THEN
          FMIN=FVAL
          DO I1=1,NVEC
            XMIN(I1)=XVEC(I1)
          ENDDO
C
C Debug:
C
          WRITE (6,998) FMIN,ILOOP
        ENDIF
C
      ENDDO
C
C Copy minimum back to XVEC
C
      DO I1=1,NVEC
        XVEC(I1)=XMIN(I1)
      ENDDO
C
C End
C
      RETURN
C
 699  FORMAT (' '/
     +        ' *** Error: parameter vector too large ***'/)
C
 998  FORMAT (' MONTE:   improved minimum value = ',
     +        1PE15.5,' at iteration = ',I6)
 999  FORMAT (' '/
     +        ' MONTE:   initial function value = ',
     +        1PE15.5)
C
      END