PROGRAM simann

USE simulated_anneal_sp
USE sep
USE iniciasp_sa
USE goldcodesp

IMPLICIT NONE

INTEGER, PARAMETER      :: neps = 4
REAL ,ALLOCATABLE   :: lb(:), ub(:), x(:), xopt(:), c(:), vm(:), m(:)
REAL                :: t, eps, rt, fopt
REAL                    :: t1, eps1, rt1,sla1,svm1,lb1,ub1
INTEGER                 :: ns, nt, nfcnev, ier, iseed1, iseed2, i, maxevl, iprint, nacc, nobds
LOGICAL                 :: max

!
complex,allocatable     :: tfld(:),fun1(:)
real,allocatable        :: correl(:,:)
integer                 :: ixs
!
 call sep_init()
 call sep_begin_prog()

 call parameters()

 allocate(lb(ntot)); allocate(ub(ntot)); allocate(x(ntot)); allocate(xopt(ntot)); allocate(c(ntot)); allocate(vm(ntot))

!  Set input parameters.
!  Set input values of the input/output parameters.
 call from_param("max",max,.false.)
 call from_param("eps",eps1,1.0e-6)
 call from_param("rt",rt1,.1)
 call from_param("sla",sla1,2.)
 call from_param("svm",svm1,2.)
 call from_param("lb",lb1,-1.05)
 call from_param("ub",ub1, 1.05)
 call from_param("iseed1",iseed1,1)
 call from_param("iseed2",iseed2,2)
 call from_param("ns",ns,1) !20
 call from_param("nt",nt,5)
 call from_param("maxevl",maxevl,1000000)
 call from_param("iprint",iprint,1)
 call from_param("t",t1,95.0) !5.0)
 
 lb = lb1 ! -1.01
 ub = ub1 ! 1.01
!  Set input values of the input/output parameters.
 vm = (svm1)
 c  = (sla1)
 write(0,*) t1
 t=(t1)
 eps=(eps1)
 rt=(rt1)

! Initial model
  if (gold.and.not(exist_file("extm0"))) then
     if (encz) then
        call owgoldpw (x,1,.true.)
     else
        call owgoldpw (x,1,.false.)
     end if
  else if (gold.and.exist_file("extm0")) then
     allocate(m(ntot))
     call sreed("extm0",m,4*ntot)
     x=(m)
     deallocate(m)
  else
    call genmodel(x)
  end if

  if (gold.and.exist_file("x0")) then
     call io((x),0)
  else if (not(gold).and.exist_file("x0")) then
     call io((x),2)
  end if

  if (exist_file("corrx0")) then
     call outcorr(x,0)
  end if

!WRITE(*,1000) ntot, max, t, rt, eps, ns, nt, neps, maxevl, iprint, iseed1, iseed2

!CALL prtvec(x, ntot, 'STARTING VALUES')
!CALL prtvec(vm, ntot, 'INITIAL STEP LENGTH')
!CALL prtvec(lb, ntot, 'LOWER BOUND')
!CALL prtvec(ub, ntot, 'UPPER BOUND')
!CALL prtvec(c, ntot, 'C VECTOR')
!WRITE(*, '(/, "  ****   END OF DRIVER ROUTINE OUTPUT   ****"/,  &
!      &     "  ****   before CALL TO sa.             ****")')

CALL sa(ntot, x, max, rt, eps, ns, nt, neps, maxevl, lb, ub, c, iprint, iseed1,  &
        iseed2, t, vm, xopt, fopt, nacc, nfcnev, nobds, ier)

WRITE(*, '(/, "  ****   RESULTS AFTER SA   ****   ")')
!CALL prtvec(xopt, ntot, 'SOLUTION')
!CALL prtvec(vm, ntot, 'FINAL STEP LENGTH')
WRITE(*,1001) fopt, nfcnev, nacc, nobds, t, ier

1000 FORMAT(/,' SIMULATED ANNEALING EXAMPLE',/,/,  &
             ' NUMBER OF PARAMETERS: ',i3,'   MAXIMIZATION: ',l5, /, &
             ' INITIAL TEMP: ', g8.2, '   RT: ',g8.2, '   EPS: ',g8.2, /, &
             ' NS: ',i3, '   NT: ',i2, '   NEPS: ',i2, /,  &
             ' MAXEVL: ',i10, '   IPRINT: ',i1, '   ISEED1: ',i4,  &
             '   ISEED2: ',i4)
1001 FORMAT(/,' OPTIMAL FUNCTION VALUE: ',g20.13  &
            /,' NUMBER OF FUNCTION EVALUATIONS:     ',i10,  &
            /,' NUMBER OF ACCEPTED EVALUATIONS:     ',i10,  &
            /,' NUMBER OF OUT OF BOUND EVALUATIONS: ',i10,  &
            /,' FINAL TEMP: ', g20.13,'  IER: ', i3)

  if (exist_file("corrxf")) then
     call outcorr(xopt,1)
  end if

   if (gold) then
      if (exist_file("xf")) then
         call io((xopt),1)
      end if
      if (allocated(tfld)) deallocate(tfld);allocate(tfld(2*nw-1))
      call owfftw(tfld)
      do ixs=1,nx*nz
         tfld=0
         tfld=cmplx((xopt((ixs-1)*(2*nw-1)+1:ixs*(2*nw-1))),0)
         call owfftexe(tfld)
         xopt((ixs-1)*nw+1:ixs*nw)=(atan(imag(tfld(1:nw))*real(tfld(1:nw))/ &
                             (real(tfld(1:nw))*real(tfld(1:nw))+tiny(1.))))
      end do
      deallocate(tfld)
      xopt=2.*xopt
      call io((xopt(1:nx*nz*nw)),3)
   else
      xopt=2.*xopt
      call io((xopt),3)
   end if
 call sep_end_prog()
STOP
END PROGRAM simann
