| 1 |
C $Header: $ |
| 2 |
C $Name: $ |
| 3 |
subroutine mysimul(indic,n,f,x,g,izs,rzs,dzs) |
| 4 |
implicit none |
| 5 |
integer indic, n |
| 6 |
double precision f,x(n),g(n) |
| 7 |
integer izs(*) |
| 8 |
real rzs(*) |
| 9 |
double precision dzs(*) |
| 10 |
|
| 11 |
integer i |
| 12 |
integer iftype |
| 13 |
double precision twopi |
| 14 |
parameter ( twopi = 6.283185307179586232 ) |
| 15 |
|
| 16 |
iftype = 2 |
| 17 |
if (izs(1).eq.-1) then |
| 18 |
c generate first guess for x |
| 19 |
do i=1,n |
| 20 |
x(i)=float(i)+1. |
| 21 |
enddo |
| 22 |
if ( iftype.eq.2 ) then |
| 23 |
do i=1,n |
| 24 |
x(i)=min(x(i),+5.12D0) |
| 25 |
x(i)=max(x(i),-5.12D0) |
| 26 |
enddo |
| 27 |
endif |
| 28 |
endif |
| 29 |
if (indic.eq.1) then |
| 30 |
c do nothing, just print something |
| 31 |
print *, 'ml-simul, indic = ', indic, ', f = ', f |
| 32 |
elseif (indic.eq.4) then |
| 33 |
if (iftype.eq.0) then |
| 34 |
c compute cost function and gradient from control parameter |
| 35 |
c banana function ( Rosenbrock f(x,y)=(1-x)^2+100*(y-x^2)^2 ) |
| 36 |
f=0. |
| 37 |
do i=1,n-1 |
| 38 |
f=f + (1.-x(i))**2 + dzs(1)*(x(i+1)-x(i)**2)**2 |
| 39 |
enddo |
| 40 |
g(:)=0. |
| 41 |
do i=n-1,1,-1 |
| 42 |
c g(i) = g(i)-2.*(1.-x(i)) - 4.5*dzs(1)*x(i)*(x(i+1)-x(i)**2) |
| 43 |
g(i) = g(i)-2.*(1.-x(i)) - 4.*dzs(1)*x(i)*(x(i+1)-x(i)**2) |
| 44 |
g(i+1)= g(i+1)+2.*dzs(1)*(x(i+1)-x(i)**2) |
| 45 |
enddo |
| 46 |
elseif (iftype.eq.1) then |
| 47 |
c Himmelblau s function with 4 local minima |
| 48 |
f = ( x(1)**2 + x(2) - 11.D0 )**2 + ( x(1) + x(2)**2 - 7.D0 )**2 |
| 49 |
g(1) = 4.*x(1)*( x(1)**2 + x(2) - 11.D0 ) |
| 50 |
& + 2.*( x(1) + x(2)**2 - 7.D0 ) |
| 51 |
g(2) = 2.*( x(1)**2 + x(2) - 11.D0 ) |
| 52 |
& + 4.*x(2)*( x(1) + x(2)**2 - 7.D0 ) |
| 53 |
elseif (iftype.eq.2) then |
| 54 |
c Rastrigin function |
| 55 |
f=10.*float(n) |
| 56 |
do i=1,n |
| 57 |
if ( x(i) .gt. 5.12D0 .or. x(i) .lt. -5.12D0) then |
| 58 |
print '(A,I4,A,E12.4,A)',' x(',i,') = ',x(i),', out of range' |
| 59 |
endif |
| 60 |
f = f + x(i)**2 - cos(twopi*x(i)) |
| 61 |
g(i) = 2.*x(i) + twopi*sin(twopi*x(i)) |
| 62 |
enddo |
| 63 |
else |
| 64 |
print *, 'iftype = ', iftype, ' not implemented' |
| 65 |
stop 'ABNORMAL in mysimul' |
| 66 |
endif |
| 67 |
else |
| 68 |
print *, 'ml-simul: indic = ', indic |
| 69 |
print *, 'ml-simul: should not happen' |
| 70 |
stop 'ABNORMAL' |
| 71 |
endif |
| 72 |
return |
| 73 |
end |
| 74 |
|
Parent Directory
| 
Revision Log
| 
Revision Graph