C ================================================================= C File: lisssajous.f C ================================================================= subroutine lissajous(n,x,l,u,totiter,flag) C This subroutine try to find some y such that f(y) < f(x) by C using the Lissajous's curve defined by: C C lis(t) = (cos( p1 * r + t1 ), ... cos( pn * r + tn ) ) C C This algorithm was published on the paper: C "OTIMIZACAO GLOBAL USANDO TRAJETORIAS DENSAS E APLICACOES" C Mario Salvatierra Junior, UNICAMP C C On Entry: C C n integer, C number of variables, C C x double precision x(n), C current point, C C l double precision l(n), C lower bounds on x, C C u double precision u(n), C upper bounds on x, C C On Return C C totiter integer, C number of iterations realized by the tunneling method C C flag integer, C Indicates if a better solution was found C 0: no better solution found C 1: better solution found C PARAMETERS integer ntrials double precision INFINITO parameter ( ntrials = 2000 ) parameter ( INFINITO = 10000000000000000.0d0 ) C SCALAR ARGUMENTS integer n,flag,totiter C ARRAY ARGUMENTS double precision x(n),l(n),u(n) C LOCAL SCALARS integer i,j,k,err,itrial double precision f,ind,num,den,signal,flis,r,r2,blis C LOCAL ARRAYS double precision t(n),p(n),lis(n) C Set the local scalars flag = 0 blis = INFINITO C SET INITIAL POINT do i = 1,n lis(i) = x(i) end do C SET f(x) call evalf(n,x,f,err) C Set the curve's initial position do i = 1,n t( i ) = acos( ( 2.0d0 * x( i ) - l( i ) - u( i ) ) / + ( u( i ) - l( i ) ) ) end do C Set the p's value in radians open(01,file="primes.txt") do i = 1,n read(01,*) k p( i ) = k p( i ) = sqrt( p( i ) ) end do close(01) C SET THE LOCAL SCALARS METHOD ind = 1.0d0 den = ind num = 1.0d0 signal = 1.0d0 itrial = 0 flis = INFINITO r2 = 0.0d0 C ITERATE THE LISSAJOUS'S TUNNELING METHOD C open(01,file="lis.rst" ) C write(01,0010) x(1),x(2),f do while( ( itrial .lt. ntrials ) .and. + ( flis .ge. f ) ) itrial = itrial + 1 C Set next r, where r is on the form: C r = 1, -1, 2/1, 1/2, -2/1, -1/2, ... r = signal * ( num / den ) den = den - 1.0d0 num = num + 1.0d0 if ( den .le. 0.0d0 ) then if ( signal .lt. 0.0d0 ) then signal = 1.0d0 ind = ind * 2.0d0 else signal = -1.0d0 end if den = ind num = 1.0d0 end if r2 = r2 + 0.05d0 C MOVE ALONG THE CURVE do j = 1,n C Set a point lis in the Lissajous's curve lis( j ) = 0.5d0 * ( l( j ) + u( j ) + + ( u( j ) - l( j ) ) * + ( cos( p( j ) * r + t( j ) ) ) ) end do C Set f on the lis, point: call evalf(n,lis,flis,err) C write(01,0010) lis(1),lis(2),flis C if( flis .lt. blis ) then C write(*,*) '[',itrial,']',blis,' / ',flis, ' / ',f C blis = flis C end if end do C Check if it's better than f if ( f .gt. flis ) then C write(*,*) 'LIS !!! ',f,' --> ',flis f = flis do j = 1,n x(j) = lis(j) end do flag = 1 end if C close(01) totiter = itrial C write(*,*) 'Fim Lissajous' C read(*,*) i C NON-EXECUTABLE STATEMENTS 0010 format(D20.12,1X,D20.12,1X,D20.12) end