! ABSTRACT:
!   Simulated annealing is a global optimization method that distinguishes
!   between different local optima. Starting from an initial point, the
!   algorithm takes a step and the function is evaluated. When minimizing a
!   function, any downhill step is accepted and the process repeats from this
!   new point. An uphill step may be accepted. Thus, it can escape from local
!   optima. This uphill decision is made by the Metropolis criteria. As the
!   optimization process proceeds, the length of the steps decline and the
!   algorithm closes in on the global optimum. Since the algorithm makes very
!   few assumptions regarding the function to be optimized, it is quite
!   robust with respect to non-quadratic surfaces. The degree of robustness
!   can be adjusted by the user. In fact, simulated annealing can be used as
!   a local optimizer for difficult functions.
!
!   This implementation of simulated annealing was used in "Global Optimizatio
!   of Statistical Functions with Simulated Annealing," Goffe, Ferrier and
!   Rogers, Journal of Econometrics, vol. 60, no. 1/2, Jan./Feb. 1994, pp.
!   65-100. Briefly, we found it competitive, if not superior, to multiple
!   restarts of conventional optimization routines for difficult optimization
!   problems.
!
!   For more information on this routine, contact its author:
!   Bill Goffe, bgoffe@whale.st.usm.edu
!
!   This version was edited to change name conventions to avoid
!   conflict with user namespace
!
subroutine simann(n,x,max,rt,eps,ns,nt,neps,maxevl,lb,ub,c,iprint,iseed1,  &
  iseed2,t,vm,xopt,fopt,nacc,nfcnev,nobds,ier,fstar,xp,nacp, fcn)
  use sic_interfaces, except_this=>simann
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Version: 3.2
  !  Date: 1/22/94.
  !  Differences compared to Version 2.0:
  !     1. If a trial is out of bounds, a point is randomly selected
  !        from LB(i) to UB(i). Unlike in version 2.0, this trial is
  !        evaluated and is counted in acceptances and rejections.
  !        All corresponding documentation was changed as well.
  !  Differences compared to Version 3.0:
  !     1. If VM(i) > (UB(i) - LB(i)), VM is set to UB(i) - LB(i).
  !        The idea is that if T is high relative to LB & UB, most
  !        points will be accepted, causing VM to rise. But, in this
  !        situation, VM has little meaning; particularly if VM is
  !        larger than the acceptable region. Setting VM to this size
  !        still allows all parts of the allowable region to be selected.
  !  Differences compared to Version 3.1:
  !     1. Test made to see if the initial temperature is positive.
  !     2. WRITE statements prettied up.
  !     3. References to paper updated.
  !
  !  Synopsis:
  !  This routine implements the continuous simulated annealing global
  !  optimization algorithm described in Corana et al.'s article
  !  "Minimizing Multimodal Functions of Continuous Variables with the
  !  "Simulated Annealing" Algorithm" in the September 1987 (vol. 13,
  !  no. 3, pp. 262-280) issue of the ACM Transactions on Mathematical
  !  Software.
  !
  !  A very quick (perhaps too quick) overview of SA:
  !     SA tries to find the global optimum of an N dimensional function.
  !  It moves both up and downhill and as the optimization process
  !  proceeds, it focuses on the most promising area.
  !     To start, it randomly chooses a trial point within the step length
  !  VM (a vector of length N) of the user selected starting point. The
  !  function is evaluated at this trial point and its value is compared
  !  to its value at the initial point.
  !     In a maximization problem, all uphill moves are accepted and the
  !  algorithm continues from that trial point. Downhill moves may be
  !  accepted; the decision is made by the Metropolis criteria. It uses T
  !  (temperature) and the size of the downhill move in a probabilistic
  !  manner. The smaller T and the size of the downhill move are, the more
  !  likely that move will be accepted. If the trial is accepted, the
  !  algorithm moves on from that point. If it is rejected, another point
  !  is chosen instead for a trial evaluation.
  !     Each element of VM periodically adjusted so that half of all
  !  function evaluations in that direction are accepted.
  !     A fall in T is imposed upon the system with the RT variable by
  !  T(i+1) = RT*T(i) where i is the ith iteration. Thus, as T declines,
  !  downhill moves are less likely to be accepted and the percentage of
  !  rejections rise. Given the scheme for the selection for VM, VM falls.
  !  Thus, as T declines, VM falls and SA focuses upon the most promising
  !  area for optimization.
  !
  !  The importance of the parameter T:
  !     The parameter T is crucial in using SA successfully. It influences
  !  VM, the step length over which the algorithm searches for optima. For
  !  a small intial T, the step length may be too small; thus not enough
  !  of the function might be evaluated to find the global optima. The user
  !  should carefully examine VM in the intermediate output (set IPRINT =
  !  1) to make sure that VM is appropriate. The relationship between the
  !  initial temperature and the resulting step length is function
  !  dependent.
  !     To determine the starting temperature that is consistent with
  !  optimizing a function, it is worthwhile to run a trial run first. Set
  !  RT = 1.5 and T = 1.0. With RT > 1.0, the temperature increases and VM
  !  rises as well. Then select the T that produces a large enough VM.
  !
  !  For modifications to the algorithm and many details on its use,
  !  (particularly for econometric applications) see Goffe, Ferrier
  !  and Rogers, "Global Optimization of Statistical Functions with
  !  Simulated Annealing," Journal of Econometrics, vol. 60, no. 1/2,
  !  Jan./Feb. 1994, pp. 65-100.
  !  For more information, contact
  !              Bill Goffe
  !              Department of Economics and International Business
  !              University of Southern Mississippi
  !              Hattiesburg, MS  39506-5072
  !              (601) 266-4484 (office)
  !              (601) 266-4920 (fax)
  !              bgoffe@whale.st.usm.edu (Internet)
  !
  !  As far as possible, the parameters here have the same name as in
  !  the description of the algorithm on pp. 266-8 of Corana et al.
  !
  !  In this description, SP is single precision, DP is real(kind=8) ,
  !  INT is integer, L is logical and (N) denotes an array of length n.
  !  Thus, DP(N) denotes a real(kind=8)  array of length n.
  !
  !  Input Parameters:
  !    Note: The suggested values generally come from Corana et al. To
  !          drastically reduce runtime, see Goffe et al., pp. 90-1 for
  !          suggestions on choosing the appropriate RT and NT.
  !    N - Number of variables in the function to be optimized. (INT)
  !    X - The starting values for the variables of the function to be
  !        optimized. (DP(N))
  !    MAX - Denotes whether the function should be maximized or
  !          minimized. A true value denotes maximization while a false
  !          value denotes minimization. Intermediate output (see IPRINT)
  !          takes this into account. (L)
  !    RT - The temperature reduction factor. The value suggested by
  !         Corana et al. is .85. See Goffe et al. for more advice. (DP)
  !    EPS - Error tolerance for termination. If the final function
  !          values from the last neps temperatures differ from the
  !          corresponding value at the current temperature by less than
  !          EPS and the final function value at the current temperature
  !          differs from the current optimal function value by less than
  !          EPS, execution terminates and IER = 0 is returned. (EP)
  !    NS - Number of cycles. After NS*N function evaluations, each
  !         element of VM is adjusted so that approximately half of
  !         all function evaluations are accepted. The suggested value
  !         is 20. (INT)
  !    NT - Number of iterations before temperature reduction. After
  !         NT*NS*N function evaluations, temperature (T) is changed
  !         by the factor RT. Value suggested by Corana et al. is
  !         MAX(100, 5*N). See Goffe et al. for further advice. (INT)
  !    NEPS - Number of final function values used to decide upon termi-
  !           nation. See EPS. Suggested value is 4. (INT)
  !    MAXEVL - The maximum number of function evaluations. If it is
  !             exceeded, IER = 1. (INT)
  !    LB - The lower bound for the allowable solution variables. (DP(N))
  !    UB - The upper bound for the allowable solution variables. (DP(N))
  !         If the algorithm chooses X(I) .LT. LB(I) or X(I) .GT. UB(I),
  !         I = 1, N, a point is from inside is randomly selected. This
  !         This focuses the algorithm on the region inside UB and LB.
  !         Unless the user wishes to concentrate the search to a par-
  !         ticular region, UB and LB should be set to very large positive
  !         and negative values, respectively. Note that the starting
  !         vector X should be inside this region. Also note that LB and
  !         UB are fixed in position, while VM is centered on the last
  !         accepted trial set of variables that optimizes the function.
  !    C - Vector that controls the step length adjustment. The suggested
  !        value for all elements is 2.0. (DP(N))
  !    IPRINT - controls printing inside SA. (INT)
  !             Values: 0 - Nothing printed.
  !                     1 - Function value for the starting value and
  !                         summary results before each temperature
  !                         reduction. This includes the optimal
  !                         function value found so far, the total
  !                         number of moves (broken up into uphill,
  !                         downhill, accepted and rejected), the
  !                         number of out of bounds trials, the
  !                         number of new optima found at this
  !                         temperature, the current optimal X and
  !                         the step length VM. Note that there are
  !                         N*NS*NT function evalutations before each
  !                         temperature reduction. Finally, notice is
  !                         is also given upon achieveing the termination
  !                         criteria.
  !                     2 - Each new step length (VM), the current optimal
  !                         X (XOPT) and the current trial X (X). This
  !                         gives the user some idea about how far X
  !                         strays from XOPT as well as how VM is adapting
  !                         to the function.
  !                     3 - Each function evaluation, its acceptance or
  !                         rejection and new optima. For many problems,
  !                         this option will likely require a small tree
  !                         if hard copy is used. This option is best
  !                         used to learn about the algorithm. A small
  !                         value for MAXEVL is thus recommended when
  !                         using IPRINT = 3.
  !             Suggested value: 1
  !             Note: For a given value of IPRINT, the lower valued
  !                   options (other than 0) are utilized.
  !    ISEED1 - The first seed for the random number generator RANMAR.
  !             0 .LE. ISEED1 .LE. 31328. (INT)
  !    ISEED2 - The second seed for the random number generator RANMAR.
  !             0 .LE. ISEED2 .LE. 30081. Different values for ISEED1
  !             and ISEED2 will lead to an entirely different sequence
  !             of trial points and decisions on downhill moves (when
  !             maximizing). See Goffe et al. on how this can be used
  !             to test the results of SA. (INT)
  !
  !  Input/Output Parameters:
  !    T - On input, the initial temperature. See Goffe et al. for advice.
  !        On output, the final temperature. (DP)
  !    VM - The step length vector. On input it should encompass the
  !         region of interest given the starting value X. For point
  !         X(I), the next trial point is selected is from X(I) - VM(I)
  !         to  X(I) + VM(I). Since VM is adjusted so that about half
  !         of all points are accepted, the input value is not very
  !         important (i.e. is the value is off, SA adjusts VM to the
  !         correct value). (DP(N))
  !
  !  Output Parameters:
  !    XOPT - The variables that optimize the function. (DP(N))
  !    FOPT - The optimal value of the function. (DP)
  !    NACC - The number of accepted function evaluations. (INT)
  !    NFCNEV - The total number of function evaluations. In a minor
  !             point, note that the first evaluation is not used in the
  !             core of the algorithm; it simply initializes the
  !             algorithm. (INT).
  !    NOBDS - The total number of trial function evaluations that
  !            would have been out of bounds of LB and UB. Note that
  !            a trial point is randomly selected between LB and UB.
  !            (INT)
  !    IER - The error return number. (INT)
  !          Values: 0 - Normal return; termination criteria achieved.
  !                  1 - Number of function evaluations (NFCNEV) is
  !                      greater than the maximum number (MAXEVL).
  !                  2 - The starting value (X) is not inside the
  !                      bounds (LB and UB).
  !                  3 - The initial temperature is not positive.
  !                  99 - Should not be seen; only used internally.
  !
  !  Work arrays that must be dimensioned in the calling routine:
  !       RWK1 (DP(NEPS))  (FSTAR in SA)
  !       RWK2 (DP(N))     (XP    "  " )
  !       IWK  (INT(N))    (NACP  "  " )
  !
  !  Required Functions (included):
  !    EXPREP - Replaces the function EXP to avoid under- and overflows.
  !             It may have to be modified for non IBM-type main-
  !             frames. (DP)
  !    RMARIN - Initializes the random number generator RANMAR.
  !    RANMAR - The actual random number generator. Note that
  !             RMARIN must run first (SA does this). It produces uniform
  !             random numbers on [0,1]. These routines are from
  !             Usenet's comp.lang.fortran. For a reference, see
  !             "Toward a Universal Random Number Generator"
  !             by George Marsaglia and Arif Zaman, Florida State
  !             University Report: FSU-SCRI-87-50 (1987).
  !             It was later modified by F. James and published in
  !             "A Review of Pseudo-random Number Generators." For
  !             further information, contact stuart@ads.com. These
  !             routines are designed to be portable on any machine
  !             with a 24-bit or more mantissa. I have found it produces
  !             identical results on a IBM 3081 and a Cray Y-MP.
  !
  !  Required Subroutines (included):
  !    SIMAN_PRTVEC - Prints vectors.
  !    SIMAN_PRT1 ... SIMAN_PRT10 - Prints intermediate output.
  !    FCN - Function to be optimized. The form is
  !            SUBROUTINE FCN(N,X,F)
  !            INTEGER N
  !            real(kind=8)   X(N), F
  !            ...
  !            function code with F = F(X)
  !            ...
  !            RETURN
  !            END
  !          Note: This is the same form used in the multivariable
  !          minimization algorithms in the IMSL edition 10 library.
  !
  !  Machine Specific Features:
  !    1. EXPREP may have to be modified if used on non-IBM type main-
  !       frames. Watch for under- and overflows in EXPREP.
  !    2. Some FORMAT statements use G25.18; this may be excessive for
  !       some machines.
  !    3. RMARIN and RANMAR are designed to be protable; they should not
  !       cause any problems.
  !  Type all external variables.
  !---------------------------------------------------------------------
  integer ::  n                     !
  real(kind=8) ::   x(*)            !
  logical ::  max                   !
  real(kind=8) ::   rt              !
  real(kind=8) ::   eps             !
  integer ::  ns                    !
  integer ::  nt                    !
  integer ::  neps                  !
  integer ::  maxevl                !
  real(kind=8) ::   lb(*)           !
  real(kind=8) ::   ub(*)           !
  real(kind=8) ::   c(*)            !
  integer ::  iprint                !
  integer ::  iseed1                !
  integer ::  iseed2                !
  real(kind=8) ::   t               !
  real(kind=8) ::   vm(*)           !
  real(kind=8) ::   xopt(*)         !
  real(kind=8) ::   fopt            !
  integer ::  nacc                  !
  integer ::  nfcnev                !
  integer ::  nobds                 !
  integer ::  ier                   !
  real(kind=8) ::   fstar(*)        !
  real(kind=8) ::   xp(*)           !
  integer ::  nacp(*)               !
  external :: fcn                   !
  ! Local
  !  Type all internal variables.
  real(kind=8) ::   f, fp, p, pp, ratio
  integer ::  nup, ndown, nrej, nnew, lnobds, h, i, j, m
  logical ::  quit
  !  Messaging
  character(len=message_length) :: mess
  character(len=6) :: rname = 'ANNEAL'
  !
  !  Initialize the random number generator RANMAR.
  call rmarin(iseed1,iseed2)
  !  Set initial values.
  nacc = 0
  nobds = 0
  nfcnev = 0
  ier = 99
  !
  xopt(1:n) = x(1:n)
  nacp(1:n) = 0
  fstar(1:neps) = 1.0d+20
  !
  !  If the initial temperature is not positive, notify the user and
  !  return to the calling routine.
  if (t .le. 0.0) then
     write(mess,*) 'Annealing temperature is negative ',T
     call sic_message (seve%e,rname,mess)
     ier = 3
     return
  endif
  !  If the initial value is out of bounds, notify the user and return
  !  to the calling routine.
  do i = 1, n
     if ((x(i) .gt. ub(i)) .or. (x(i) .lt. lb(i))) then
        call siman_prt1
        ier = 2
        return
     endif
  enddo
  !  Evaluate the function with input X and return value as F.
  call fcn(n,x,f,ier)
  !  If the function is to be minimized, switch the sign of the function.
  !  Note that all intermediate and final output switches the sign back
  !  to eliminate any possible confusion for the user.
  if (.not. max) f = -f
  nfcnev = nfcnev + 1
  fopt = f
  fstar(1) = f
  if (iprint .ge. 1) call siman_prt2(max,n,x,f)
  !  Start the main loop. Note that it terminates if (i) the algorithm
  !  succesfully optimizes the function or (ii) there are too many
  !  function evaluations (more than MAXEVL).
  do while (.true.)
     nup = 0
     nrej = 0
     nnew = 0
     ndown = 0
     lnobds = 0
     !
     do m = 1, nt
        do j = 1, ns
           do h = 1, n
              !  Generate XP, the trial value of X. Note use of VM to choose XP.
              do i = 1, n
                 if (i .eq. h) then
                    xp(i) = x(i) + (ranmar()*2.- 1.) * vm(i)
                 else
                    xp(i) = x(i)
                 endif
                 !  If XP is out of bounds, select a point in bounds for the trial.
                 if ((xp(i) .lt. lb(i)) .or. (xp(i) .gt. ub(i))) then
                    xp(i) = lb(i) + (ub(i) - lb(i))*ranmar()
                    lnobds = lnobds + 1
                    nobds = nobds + 1
                    if (iprint .ge. 3) call siman_prt3(max,n,xp,x,fp,f)
                 endif
              enddo
              !  Evaluate the function with the trial point XP and return as FP.
              call fcn(n,xp,fp,ier)
              if (ier.eq.-1) then
                 call sic_message (seve%i,rname,'Aborted by user (^C)')
                 return
              endif
              if (.not. max) fp = -fp
              nfcnev = nfcnev + 1
              if (iprint .ge. 3) call siman_prt4(max,n,xp,x,fp,f)
              !  If too many function evaluations occur, terminate the algorithm.
              if (nfcnev .ge. maxevl) then
                 if (iprint.ge.0) then
                    call sic_message (seve%w,rname,'Too many functions evaluations')
                    write(mess,*) 'Increase MAXEVL ',maxevl,' or EPS ',eps
                    call sic_message (seve%w,rname,mess)
                 endif
                 if (.not. max) fopt = -fopt
                 ier = 1
                 return
              endif
              !  Accept the new point if the function value increases.
              if (fp .ge. f) then
                 if (iprint .ge. 3) then
                    write(*,'(''  POINT ACCEPTED'')')
                 endif
                 x(1:n) = xp(1:n)
                 f = fp
                 nacc = nacc + 1
                 nacp(h) = nacp(h) + 1
                 nup = nup + 1
                 !  If greater than any other point, record as new optimum.
                 if (fp .gt. fopt) then
                    if (iprint .ge. 3) then
                       write(*,'(''  NEW OPTIMUM'')')
                    endif
                    xopt(1:n) = xp(1:n)
                    fopt = fp
                    nnew = nnew + 1
                 endif
                 !  If the point is lower, use the Metropolis criteria to decide on
                 !  acceptance or rejection.
              else
                 p = exprep((fp - f)/t)
                 pp = ranmar()
                 if (pp .lt. p) then
                    if (iprint .ge. 3) call siman_prt6(max)
                    x(1:n) = xp(1:n)
                    f = fp
                    nacc = nacc + 1
                    nacp(h) = nacp(h) + 1
                    ndown = ndown + 1
                 else
                    nrej = nrej + 1
                    if (iprint .ge. 3) call siman_prt7(max)
                 endif
              endif
           enddo
        enddo
        !  Adjust VM so that approximately half of all evaluations are accepted.
        do i = 1, n
           ratio = dfloat(nacp(i)) /dfloat(ns)
           if (ratio .gt. .6) then
              vm(i) = vm(i)*(1. + c(i)*(ratio - .6)/.4)
           elseif  (ratio .lt. .4) then
              vm(i) = vm(i)/(1. + c(i)*((.4 - ratio)/.4))
           endif
           if (vm(i) .gt. (ub(i)-lb(i))) then
              vm(i) = ub(i) - lb(i)
           endif
        enddo
        if (iprint .ge. 2) then
           call siman_prt8(n,vm,xopt,x)
        endif
        nacp(1:n) = 0
     enddo
     !
     if (iprint .ge. 1) then
        call siman_prt9(max,n,t,xopt,vm,fopt,nup,ndown,nrej,lnobds,nnew)
     endif
     !  Check termination criteria.
     quit = .false.
     fstar(1) = f
     if ((fopt - fstar(1)) .le. eps) quit = .true.
     do i = 1, neps
        if (abs(f - fstar(i)) .gt. eps) quit = .false.
     enddo
     !  Terminate SA if appropriate.
     if (quit) then
        x(1:n) = xopt(1:n)
        ier = 0
        if (.not. max) fopt = -fopt
        if (iprint.ge.0) then
           write(mess,*) 'Termination criterium achieved ',ier,nfcnev
           call sic_message (seve%i,rname,mess)
        endif
        return
     endif
     !
     !  If termination criteria is not met, prepare for another loop.
     t = rt*t
     do i = neps, 2, -1
        fstar(i) = fstar(i-1)
     enddo
     f = fopt
     x(1:n) = xopt(1:n)
     !  Loop again.
  enddo
end subroutine simann
!
function exprep(rdum)
  !---------------------------------------------------------------------
  ! @ private
  !  This function replaces exp to avoid under- and overflows and is
  !  designed for IBM 370 type machines. It may be necessary to modify
  !  it for other machines. Note that the maximum and minimum values of
  !  EXPREP are such that they has no effect on the algorithm.
  !---------------------------------------------------------------------
  real(kind=8) :: exprep  ! Function value on return
  real(kind=8), intent(in) :: rdum  !
  !
  if (rdum.gt.174.d0) then
     exprep = 3.69d+75
  elseif (rdum.lt.-180.d0) then
     exprep = 0.0
  else
     exprep = exp(rdum)
  endif
  !
end function exprep
!
subroutine rmarin(ij,kl)
  use sic_interfaces, except_this=>rmarin
  !---------------------------------------------------------------------
  ! @ private
  !  This subroutine and the next function generate random numbers. See
  !  the comments for SA for more information. The only changes from the
  !  orginal code is that (1) the test to make sure that RMARIN runs first
  !  was taken out since SA assures that this is done (this test didn't
  !  compile under IBM's VS Fortran) and (2) typing ivec as integer was
  !  taken out since ivec isn't used. With these exceptions, all following
  !  lines are original.
  ! This is the initialization routine for the random number generator
  !     RANMAR()
  ! NOTE: The seed variables can have values between:    0 <= IJ <= 31328
  !                                                      0 <= KL <= 30081
  !---------------------------------------------------------------------
  integer :: ij                     !
  integer :: kl                     !
  ! Local
  real :: u(97), c, cd, cm
  integer :: i97, j97
  common /raset1/ u, c, cd, cm, i97, j97
  !
  integer :: i,j,k,l, ii, jj, m
  real :: s, t
  !
  if ( ij.lt.0 .or. ij.gt.31328 .or. kl.lt.0 .or. kl.gt.30081 ) then
     print '(A)',' The first random number seed must have a value '//  &
     'between 0 and 31328'
     print '(A)',' The second seed must have a value between 0 and 30081'
     stop
  endif
  i = mod(ij/177, 177) + 2
  j = mod(ij    , 177) + 2
  k = mod(kl/169, 178) + 1
  l = mod(kl,     169)
  !
  do ii = 1, 97
     s = 0.0
     t = 0.5
     do jj = 1, 24
        m = mod(mod(i*j, 179)*k, 179)
        i = j
        j = k
        k = m
        l = mod(53*l+1, 169)
        if (mod(l*m, 64) .ge. 32) then
           s = s + t
        endif
        t = 0.5 * t
     enddo
     u(ii) = s
  enddo
  !
  c = 362436.0 / 16777216.0
  cd = 7654321.0 / 16777216.0
  cm = 16777213.0 /16777216.0
  i97 = 97
  j97 = 33
  return
end subroutine rmarin
!
function ranmar()
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  real :: ranmar                    !
  ! Local
  real :: u(97), c, cd, cm
  integer :: i97, j97
  common /raset1/ u, c, cd, cm, i97, j97
  !
  real :: uni
  !
  uni = u(i97) - u(j97)
  if ( uni .lt. 0.0 ) uni = uni + 1.0
  u(i97) = uni
  i97 = i97 - 1
  if (i97 .eq. 0) i97 = 97
  j97 = j97 - 1
  if (j97 .eq. 0) j97 = 97
  c = c - cd
  if ( c .lt. 0.0 ) c = c + cm
  uni = uni - c
  if ( uni .lt. 0.0 ) uni = uni + 1.0
  ranmar = uni
  !
end function ranmar
!
subroutine siman_prt1
  !---------------------------------------------------------------------
  ! @ private
  !  This subroutine prints intermediate output, as does SIMAN_PRT2 through
  !  SIMAN_PRT10. Note that if SA is minimizing the function, the sign of the
  !  function value and the directions (up/down) are reversed in all
  !  output to correspond with the actual function optimization. This
  !  correction is because SA was written to maximize functions and
  !  it minimizes by maximizing the negative a function.
  !---------------------------------------------------------------------
  write(*,'(/,''  The starting value (X) is outside the bounds ''  &
       &    /,''  (LB and UB). execution terminated without any''  &
       &    /,''  optimization. respecify X, UB or LB so that  ''  &
       &    /,''  LB(I) .LT. X(I) .LT. UB(I), I = 1, N. ''/)')
  return
end subroutine siman_prt1
!
subroutine siman_prt2(max,n,x,f)
  use sic_interfaces, except_this=>siman_prt2
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  integer ::  n                     !
  real(kind=8) ::   x(*)            !
  real(kind=8) ::   f               !
  !
  write(*,'(''  '')')
  call siman_prtvec(x,n,'Initial X')
  if (max) then
     write(*,'(''  Initial F: '',1PG25.18)') f
  else
     write(*,'(''  Initial F: '',1PG25.18)') -f
  endif
  return
end subroutine siman_prt2
!
subroutine siman_prt3(max,n,xp,x,fp,f)
  use sic_interfaces, except_this=>siman_prt3
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  integer ::  n                     !
  real(kind=8) ::   xp(*)           !
  real(kind=8) ::   x(*)            !
  real(kind=8) ::   fp              !
  real(kind=8) ::   f               !
  !
  write(*,'(''  '')')
  call siman_prtvec(x,n,'Current X')
  if (max) then
     write(*,'(''  Current F: '',1PG25.18)') f
  else
     write(*,'(''  Current F: '',1PG25.18)') -f
  endif
  call siman_prtvec(xp,n,'Trial X')
  write(*,'(''  Point rejected since out of bounds'')')
  return
end subroutine siman_prt3
!
subroutine siman_prt4(max,n,xp,x,fp,f)
  use sic_interfaces, except_this=>siman_prt4
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  integer ::  n                     !
  real(kind=8) ::   xp(*)           !
  real(kind=8) ::   x(*)            !
  real(kind=8) ::   fp              !
  real(kind=8) ::   f               !
  !
  write(*,'(''  '')')
  call siman_prtvec(x,n,'Current X')
  if (max) then
     write(*,'(''  Current F: '',1PG25.18)') f
     call siman_prtvec(xp,n,'Trial X')
     write(*,'(''  Resulting F: '',1PG25.18)') fp
  else
     write(*,'(''  Current F: '',1PG25.18)') -f
     call siman_prtvec(xp,n,'Trial X')
     write(*,'(''  Resulting F: '',1PG25.18)') -fp
  endif
  return
end subroutine siman_prt4
!
subroutine siman_prt6(max)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  if (max) then
     write(*,'(''  Though lower, point accepted'')')
  else
     write(*,'(''  Though higher, point accepted'')')
  endif
  return
end subroutine siman_prt6
!
subroutine siman_prt7(max)
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  if (max) then
     write(*,'(''  Lower point rejected'')')
  else
     write(*,'(''  Higher point rejected'')')
  endif
  return
end subroutine siman_prt7
!
subroutine siman_prt8(n,vm,xopt,x)
  use sic_interfaces, except_this=>siman_prt8
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer ::  n                     !
  real(kind=8) ::   vm(*)           !
  real(kind=8) ::   xopt(*)         !
  real(kind=8) ::   x(*)            !
  !
  write(*,'(/,'' Intermediate results after step length adjustment'',/)')
  call siman_prtvec(vm,n,'New step length (VM)')
  call siman_prtvec(xopt,n,'Current optimal X')
  call siman_prtvec(x,n,'Current X')
  write(*,'('' '')')
  return
end subroutine siman_prt8
!
subroutine siman_prt9(max,n,t,xopt,vm,fopt,nup,ndown,nrej,lnobds,nnew)
  use sic_interfaces, except_this=>siman_prt9
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  logical ::  max                   !
  integer ::  n                     !
  real(kind=8) ::   t               !
  real(kind=8) ::   xopt(*)         !
  real(kind=8) ::   vm(*)           !
  real(kind=8) ::   fopt            !
  integer ::  nup                   !
  integer ::  ndown                 !
  integer ::  nrej                  !
  integer ::  lnobds                !
  integer ::  nnew                  !
  ! Local
  integer ::  totmov
  !
  totmov = nup + ndown + nrej
  write(*,'(/,'' Intermediate results before next temperature reduction'',/)')
  write(*,'(''  Current temperature:            '',G12.5)') t
  if (max) then
     write(*,'(''  Max value so far:  '',G25.18)') fopt
     write(*,'(''  Total moves:                '',i8)') totmov
     write(*,'(''     Uphill:                  '',i8)') nup
     write(*,'(''     Accepted Downhill:       '',i8)') ndown
     write(*,'(''     Rejected Downhill:       '',i8)') nrej
     write(*,'(''  Out of bounds trials:       '',i8)') lnobds
     write(*,'(''  New maxima this temperature:'',i8)') nnew
  else
     write(*,'(''  Min value so far:  '',g25.18)') -fopt
     write(*,'(''  Total moves:                '',i8)') totmov
     write(*,'(''     Downhill:                '',i8)')  nup
     write(*,'(''     Accepted uphill:         '',i8)')  ndown
     write(*,'(''     Rejected uphill:         '',i8)')  nrej
     write(*,'(''  Trials out of bounds:       '',i8)')  lnobds
     write(*,'(''  New minima this temperature:'',i8)')  nnew
  endif
  call siman_prtvec(xopt,n,'Current optimal X')
  call siman_prtvec(vm,n,'Step length (VM)')
  write(*,'('' '')')
  return
end subroutine siman_prt9
    !
subroutine siman_prtvec(vector,ncols,name)
  !---------------------------------------------------------------------
  ! @ private
  !  This subroutine prints the real(kind=8)  vector named VECTOR.
  !  Elements 1 thru NCOLS will be printed. NAME is a character variable
  !  that describes VECTOR. Note that if NAME is given in the call to
  !  SIMAN_PRTVEC, it must be enclosed in quotes. If there are more than 10
  !  elements in VECTOR, 10 elements will be printed on each line.
  !---------------------------------------------------------------------
  integer :: ncols                  !
  real(kind=8) ::  vector(ncols)    !
  character(len=*) :: name          !
  !
  write(*,1001) name
  write(*,1000) vector
  !
1000 format(10(g12.5,1x))
1001 format(/,25x,a)
  return
end subroutine siman_prtvec
