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