Actual source code: rosenbrock1f.F
1: ! "$Id$";
2: !
3: ! Program usage: mpirun -np 1 rosenbrock1f [-help] [all TAO options]
4: !
5: ! Description: This example demonstrates use of the TAO package to solve an
6: ! unconstrained minimization problem on a single processor. We minimize the
7: ! extended Rosenbrock function:
8: ! sum_{i=0}^{n/2-1} ( alpha*(x_{2i+1}-x_{2i}^2)^2 + (1-x_{2i})^2 )
9: !
10: ! The C version of this code is rosenbrock1.c
11: !
12: !/*T
13: ! Concepts: TAO - Solving an unconstrained minimization problem
14: ! Routines: TaoInitialize(); TaoFinalize(); TaoSetOptions();
15: ! Routines: TaoApplicationCreate();
16: ! Routines: TaoCreate(); TaoAppSetObjectiveAndGradientRoutine();
17: ! Routines: TaoAppSetHessianMat(); TaoAppSetHessianRoutine();
18: ! Routines: TaoAppSetInitialSolutionVec();
19: ! Routines: TaoSolveApplication(); TaoDestroy(); TaoAppDestroy();
20: ! Routines: TaoView(); TaoGetTerminationReason();
21: ! Processors: 1
22: !T*/
23: !
24: ! ----------------------------------------------------------------------
25: !
26: implicit none
28: #include "rosenbrock1f.h"
30: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
31: ! Variable declarations
32: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
33: !
34: ! See additional variable declarations in the file rosenbrock1f.h
36: integer info ! used to check for functions returning nonzeros
37: Vec x ! solution vector
38: Mat H ! hessian matrix
39: TAO_SOLVER tao ! TAO_SOVER context
40: TAO_APPLICATION taoapp ! TAO application context
41: PetscTruth flg
42: integer size,rank ! number of processes running
43: PetscScalar zero
44: TaoTerminateReason reason
46:
49: ! Note: Any user-defined Fortran routines (such as FormGradient)
50: ! MUST be declared as external.
52: external FormFunctionGradient,FormHessian
54: zero = 0.0d0
56: ! Initialize TAO and PETSc
57: call PetscInitialize(PETSC_NULL_CHARACTER,info)
58: call TaoInitialize(PETSC_NULL_CHARACTER,info)
60: call MPI_Comm_size(PETSC_COMM_WORLD,size,info)
61: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,info)
62: if (size .ne. 1) then
63: if (rank .eq. 0) then
64: write(6,*) 'This is a uniprocessor example only!'
65: endif
66: SETERRQ(1,' ',info)
67: endif
69: ! Initialize problem parameters
70: n = 2
71: alpha = 99.0d0
75: ! Check for command line arguments to override defaults
76: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg, &
77: & info)
78: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-alpha', &
79: & alpha,flg,info)
81: ! Allocate vectors for the solution and gradient
82: call VecCreateSeq(PETSC_COMM_SELF,n,x,info)
84: ! Allocate storage space for Hessian;
85: call MatCreateSeqBDiag(PETSC_COMM_SELF,n,n,0,2,0,0,H,info)
86: call MatSetOption(H,MAT_SYMMETRIC,info)
89: ! The TAO code begins here
91: ! Create TAO solver
92: call TaoCreate(PETSC_COMM_SELF,TAO_NULL_CHARACTER,tao,info)
93: call TaoApplicationCreate(PETSC_COMM_SELF,taoapp,info)
94: ! Set routines for function, gradient, and hessian evaluation
96: ! TaoAppSetObjectiveAndGradientRoutine is shortened to 31 chars to comply with some compilers
97: call TaoAppSetObjectiveAndGradientRo(taoapp, &
98: & FormFunctionGradient,TAO_NULL_OBJECT,info)
99: call TaoAppSetHessianMat(taoapp,H,H,info)
100: call TaoAppSetHessianRoutine(taoapp,FormHessian,TAO_NULL_OBJECT, &
101: & info)
103: ! Optional: Set initial guess
104: call VecSet(x, zero, info)
105: call TaoAppSetInitialSolutionVec(taoapp, x, info)
108: ! Check for TAO command line options
109: call TaoSetTolerances(tao,1.0d-3,1.0d-3,1.0d-3,1.0d-3,info)
110: call TaoSetOptions(taoapp,tao,info)
112: ! SOLVE THE APPLICATION
113: call TaoSolveApplication(taoapp,tao,info)
115: call TaoGetTerminationReason(tao, reason, info)
116: if (reason .le. 0) then
117: print *,'Try a different TAO method, adjust some parameters,'
118: print *,'or check the function evaluation routines.'
119: endif
121: ! TaoView() prints info about the TAO solver; the option
122: ! -tao_view
123: ! can alternatively be used to activate this at runtime.
124: ! call TaoView(tao,info)
125:
127: ! Free TAO data structures
128: call TaoDestroy(tao,info)
129: call TaoAppDestroy(taoapp,info)
131: ! Free PETSc data structures
132: call VecDestroy(x,info)
133: call MatDestroy(H,info)
135: ! Finalize TAO
136: call TaoFinalize(info)
137: call PetscFinalize(info)
139: end
142: ! --------------------------------------------------------------------
143: ! FormFunctionGradient - Evaluates the function f(X) and gradient G(X)
144: !
145: ! Input Parameters:
146: ! tao - the TAO_SOLVER context
147: ! X - input vector
148: ! dummy - not used
149: !
150: ! Output Parameters:
151: ! G - vector containing the newly evaluated gradient
152: ! f - function value
153:
154: subroutine FormFunctionGradient(taoapp, X, f, G, dummy, info)
155: implicit none
157: ! n,alpha defined in rosenbrock1f.h
158: #include "rosenbrock1f.h"
160: TAO_APPLICATION taoapp
161: Vec X,G
162: PetscScalar f
163: integer dummy, info
166: PetscScalar ff,t1,t2
167: integer i,nn
169: ! PETSc's VecGetArray acts differently in Fortran than it does in C.
170: ! Calling VecGetArray((Vec) X, (PetscScalar) x_array(0:1), (PetscOffset) x_index, info)
171: ! will return an array of doubles referenced by x_array offset by x_index.
172: ! i.e., to reference the kth element of X, use x_array(k + x_index).
173: ! Notice that by declaring the arrays with range (0:1), we are using the C 0-indexing practice.
174: PetscScalar g_v(0:1),x_v(0:1)
175: PetscOffset g_i,x_i
177: info = 0
178: nn = n/2
179: ff = 0
181: ! Get pointers to vector data
182: call VecGetArray(X,x_v,x_i,info)
183: call VecGetArray(G,g_v,g_i,info)
186: ! Compute G(X)
187: do i=0,nn-1
188: t1 = x_v(x_i+2*i+1) - x_v(x_i+2*i)*x_v(x_i+2*i)
189: t2 = 1.0 - x_v(x_i + 2*i)
190: ff = ff + alpha*t1*t1 + t2*t2
191: g_v(g_i + 2*i) = -4*alpha*t1*x_v(x_i + 2*i) - 2.0*t2
192: g_v(g_i + 2*i + 1) = 2.0*alpha*t1
193: enddo
195: ! Restore vectors
196: call VecRestoreArray(X,x_v,x_i,info)
197: call VecRestoreArray(G,g_v,g_i,info)
199: f = ff
200: call PetscLogFlops(nn*15,info)
202: return
203: end
205: !
206: ! ---------------------------------------------------------------------
207: !
208: ! FormHessian - Evaluates Hessian matrix.
209: !
210: ! Input Parameters:
211: ! tao - the TAO_SOLVER context
212: ! X - input vector
213: ! dummy - optional user-defined context, as set by SNESSetHessian()
214: ! (not used here)
215: !
216: ! Output Parameters:
217: ! H - Hessian matrix
218: ! PrecH - optionally different preconditioning matrix (not used here)
219: ! flag - flag indicating matrix structure
220: ! info - error code
221: !
222: ! Note: Providing the Hessian may not be necessary. Only some solvers
223: ! require this matrix.
225: subroutine FormHessian(taoapp,X,H,PrecH,flag,dummy,info)
226: implicit none
228: #include "rosenbrock1f.h"
230: ! Input/output variables:
231: TAO_APPLICATION taoapp
232: Vec X
233: Mat H, PrecH
234: MatStructure flag
235: integer dummy,info
236:
237: PetscScalar v(0:1,0:1)
238: PetscTruth assembled
240: ! PETSc's VecGetArray acts differently in Fortran than it does in C.
241: ! Calling VecGetArray((Vec) X, (PetscScalar) x_array(0:1), (PetscOffset) x_index, info)
242: ! will return an array of doubles referenced by x_array offset by x_index.
243: ! i.e., to reference the kth element of X, use x_array(k + x_index).
244: ! Notice that by declaring the arrays with range (0:1), we are using the C 0-indexing practice.
245: PetscScalar x_v(0:1)
246: PetscOffset x_i
247: integer i,nn,ind(0:1)
250: info = 0
251: nn= n/2
253: ! Zero existing matrix entries
254: call MatAssembled(H,assembled,info)
255: if (assembled .eq. PETSC_TRUE) call MatZeroEntries(H,info)
257: ! Get a pointer to vector data
259: call VecGetArray(X,x_v,x_i,info)
261: ! Compute Hessian entries
263: do i=0,nn-1
264: v(1,1) = 2.0*alpha
265: v(0,0) = -4.0*alpha*(x_v(x_i+2*i+1) - &
266: & 3*x_v(x_i+2*i)*x_v(x_i+2*i))+2
267: v(1,0) = -4.0*alpha*x_v(x_i+2*i)
268: v(0,1) = v(1,0)
269: ind(0) = 2*i
270: ind(1) = 2*i + 1
271: call MatSetValues(H,2,ind,2,ind,v,INSERT_VALUES,info)
272: enddo
274: ! Restore vector
276: call VecRestoreArray(X,x_v,x_i,info)
278: ! Assemble matrix
280: call MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY,info)
281: call MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY,info)
283: call PetscLogFlops(nn*9,info)
285: ! Set flag to indicate that the Hessian matrix retains an identical
286: ! nonzero structure throughout all nonlinear iterations (although the
287: ! values of the entries change). Thus, we can save some work in setting
288: ! up the preconditioner (e.g., no need to redo symbolic factorization for
289: ! ICC preconditioners).
290: ! - If the nonzero structure of the matrix is different during
291: ! successive linear solves, then the flag DIFFERENT_NONZERO_PATTERN
292: ! must be used instead. If you are unsure whether the matrix
293: ! structure has changed or not, use the flag DIFFERENT_NONZERO_PATTERN.
294: ! - Caution: If you specify SAME_NONZERO_PATTERN, the software
295: ! believes your assertion and does not check the structure
296: ! of the matrix. If you erroneously claim that the structure
297: ! is the same when it actually is not, the new preconditioner
298: ! will not function correctly. Thus, use this optimization
299: ! feature with caution!
301: flag = SAME_NONZERO_PATTERN
303: return
304: end