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 |
|