/[MITgcm]/MITgcm_contrib/mlosch/optim_m1qn3/testbed/mysimul.F
ViewVC logotype

Annotation of /MITgcm_contrib/mlosch/optim_m1qn3/testbed/mysimul.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Wed May 2 12:27:42 2012 UTC (13 years, 2 months ago) by mlosch
Branch: MAIN
CVS Tags: HEAD
simple testing environment for optim_m1qn3

1 mlosch 1.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    

  ViewVC Help
Powered by ViewVC 1.1.22