Actual source code: toyf.F
petsc-dev 2014-02-02
1: ! Program usage: mpirun -np 1 toyf[-help] [all TAO options]
3: !
4: !min f=(x1-x2)^2 + (x2-2)^2 -2*x1-2*x2
5: !s.t. x1^2 + x2 = 2
6: ! 0 <= x1^2 - x2 <= 1
7: ! -1 <= x1,x2 <= 2
8: !----------------------------------------------------------------------
10: program toyf
11: implicit none
12: #include toyf.h
14: PetscErrorCode ierr
15: Tao tao
16: TaoTerminationReason reason
17: KSP ksp
18: PC pc
19: external FormFunctionGradient,FormHessian
20: external FormInequalityConstraints,FormEqualityConstraints
21: external FormInequalityJacobian,FormEqualityJacobian
24: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
26: call PetscPrintf(PETSC_COMM_SELF, &
27: & '\n---- TOY Problem -----\n', &
28: & ierr)
29: CHKERRQ(ierr)
31: call PetscPrintf(PETSC_COMM_SELF,'Solution should be f(1,1)=-2\n',&
32: & ierr)
33: CHKERRQ(ierr)
35: call InitializeProblem(ierr)
36: CHKERRQ(ierr)
38: call TaoCreate(PETSC_COMM_SELF,tao,ierr)
39: CHKERRQ(ierr)
41: call TaoSetType(tao,"tao_ipm",ierr)
42: CHKERRQ(ierr)
44: call TaoSetInitialVector(tao,x0,ierr)
45: CHKERRQ(ierr)
47: call TaoSetVariableBounds(tao,xl,xu,ierr)
48: CHKERRQ(ierr)
50: call TaoSetObjectiveAndGradientRoutine(tao,FormFunctionGradient, &
51: & PETSC_NULL_OBJECT,ierr)
52: CHKERRQ(ierr)
54: call TaoSetEqualityConstraintsRoutine(tao,ce, &
55: & FormEqualityConstraints,PETSC_NULL_OBJECT,ierr)
56: CHKERRQ(ierr)
58: call TaoSetInequalityConstraintsRoutine(tao,ci, &
59: & FormInequalityConstraints,PETSC_NULL_OBJECT,ierr)
60: CHKERRQ(ierr)
62: call TaoSetJacobianEqualityRoutine(tao,Ae,Ae,FormEqualityJacobian, &
63: & PETSC_NULL_OBJECT,ierr)
64: CHKERRQ(ierr)
66: call TaoSetJacobianInequalityRoutine(tao,Ai,Ai, &
67: & FormInequalityJacobian,PETSC_NULL_OBJECT,ierr)
68: CHKERRQ(ierr)
70: call TaoSetHessianRoutine(tao,Hess,Hess,FormHessian, &
71: & PETSC_NULL_OBJECT,ierr)
72: CHKERRQ(ierr)
74: call TaoSetTolerances(tao,1.0d-12,0,0,0,0,ierr)
75: CHKERRQ(ierr)
77: call TaoSetFromOptions(tao,ierr)
78: CHKERRQ(ierr)
80: call TaoGetKSP(tao,ksp,ierr)
81: CHKERRQ(ierr)
83: call KSPGetPC(ksp,pc,ierr)
84: CHKERRQ(ierr)
86: ! call PCFactorSetMatSolverPackage(pc,MATSOLVERSUPERLU)
87: ! CHKERRQ(ierr)
89: call PetscOptionsSetValue('-pc_factor_mat_solver_package', &
90: & 'superlu',ierr)
91: CHKERRQ(ierr)
93: call PCSetType(pc,PCLU,ierr)
94: CHKERRQ(ierr)
96: call KSPSetType(ksp,KSPPREONLY,ierr)
97: CHKERRQ(ierr)
99: call KSPSetFromOptions(ksp,ierr)
100: CHKERRQ(ierr)
102: call TaoSetTolerances(tao,1.0d-12,0.0d0,0.0d0,0.0d0,0.0d0,ierr)
103: CHKERRQ(ierr)
105: ! Solve
106: call TaoSolve(tao,ierr)
107: CHKERRQ(ierr)
110: ! Analyze solution
111: call TaoGetTerminationReason(tao,reason,ierr)
112: CHKERRQ(ierr)
114: ! if (reason .lt. 0) then
115: ! call PetscPrintf(MPI_COMM_WORLD, "TAO failed to converge.\n"!, &
116: ! & ierr)
117: ! else
118: ! call PetscPrintf(MPI_COMM_WORLD, ! &
119: ! & "Optimization terminated with status %D.\n", reason,ierr)
120: ! end if
122: ! Finalize Memory
123: call DestroyProblem(ierr)
124: CHKERRQ(ierr)
126: call TaoDestroy(tao,ierr)
127: CHKERRQ(ierr)
129: call PetscFinalize(ierr)
131: stop
132: end program toyf
135: subroutine InitializeProblem(ierr)
136: implicit none
137: #include toyf.h
138: PetscReal zero,minus1,two
139: PetscErrorCode ierr
140: n = 2
141: zero =0.0d0
142: minus1=-1.0d0
143: two=2.0d0
145: call VecCreateSeq(PETSC_COMM_SELF,n,x0,ierr)
146: CHKERRQ(ierr)
147: call VecDuplicate(x0,xl,ierr)
148: CHKERRQ(ierr)
149: call VecDuplicate(x0,xu,ierr)
150: CHKERRQ(ierr)
151: call VecSet(x0,zero,ierr)
152: CHKERRQ(ierr)
153: call VecSet(xl,minus1,ierr)
154: CHKERRQ(ierr)
155: call VecSet(xu,two,ierr)
156: CHKERRQ(ierr)
158: ne = 1
159: call VecCreateSeq(PETSC_COMM_SELF,ne,ce,ierr)
160: CHKERRQ(ierr)
162: ni = 2
163: call VecCreateSeq(PETSC_COMM_SELF,ni,ci,ierr)
164: CHKERRQ(ierr)
166: call MatCreateSeqAIJ(PETSC_COMM_SELF,ne,n,n,PETSC_NULL_INTEGER,Ae,&
167: & ierr)
168: CHKERRQ(ierr)
169: call MatCreateSeqAIJ(PETSC_COMM_SELF,ni,n,n,PETSC_NULL_INTEGER,Ai,&
170: & ierr)
171: CHKERRQ(ierr)
172: call MatSetFromOptions(Ae,ierr)
173: CHKERRQ(ierr)
174: call MatSetFromOptions(Ai,ierr)
175: CHKERRQ(ierr)
178: call MatCreateSeqAIJ(PETSC_COMM_SELF,n,n,1,PETSC_NULL_INTEGER,Hess&
179: & ,ierr)
180: CHKERRQ(ierr)
181: call MatSetFromOptions(Hess,ierr)
182: CHKERRQ(ierr)
183: 0
184: end subroutine InitializeProblem
187: subroutine DestroyProblem(ierr)
188: implicit none
189: #include toyf.h
191: PetscErrorCode ierr
193: call MatDestroy(Ae,ierr)
194: CHKERRQ(ierr)
195: call MatDestroy(Ai,ierr)
196: CHKERRQ(ierr)
197: call MatDestroy(Hess,ierr)
198: CHKERRQ(ierr)
200: call VecDestroy(x0,ierr)
201: CHKERRQ(ierr)
202: call VecDestroy(ce,ierr)
203: CHKERRQ(ierr)
204: call VecDestroy(ci,ierr)
205: CHKERRQ(ierr)
206: call VecDestroy(xl,ierr)
207: CHKERRQ(ierr)
208: call VecDestroy(xu,ierr)
209: CHKERRQ(ierr)
210: 0
211: end subroutine DestroyProblem
213: subroutine FormFunctionGradient(tao, X, f, G, dummy, ierr)
214: implicit none
215: #include toyf.h
217: PetscErrorCode ierr
218: PetscInt dummy
219: Vec X,G
220: Tao tao
221: PetscScalar f
222: PetscScalar x_v(0:1),g_v(0:1)
223: PetscOffset x_i,g_i
226: call VecGetArray(X,x_v,x_i,ierr)
227: CHKERRQ(ierr)
228: call VecGetArray(G,g_v,g_i,ierr)
229: CHKERRQ(ierr)
230: f=(x_v(x_i)-2.0)*(x_v(x_i)-2.0)+(x_v(x_i+1)-2.0)*(x_v(x_i+1)-2.0) &
231: & - 2.0*(x_v(x_i)+x_v(x_i+1))
232: g_v(g_i) = 2.0*(x_v(x_i)-2.0) - 2.0
233: g_v(g_i+1) = 2.0*(x_v(x_i+1)-2.0) - 2.0
234: call VecRestoreArray(X,x_v,x_i,ierr)
235: CHKERRQ(ierr)
236: call VecRestoreArray(G,g_v,g_i,ierr)
237: CHKERRQ(ierr)
238: 0
239: end subroutine FormFunctionGradient
242: subroutine FormHessian(tao,X,H,Hpre,flag,dummy,ierr)
243: implicit none
244: #include toyf.h
246: Tao tao
247: Vec X
248: Mat H, Hpre
249: MatStructure flag
250: PetscErrorCode ierr
251: PetscInt dummy
253: PetscScalar de_v(0:1),di_v(0:1)
254: PetscOffset de_i,di_i
255: PetscInt zero(1)
256: PetscInt one(1)
257: PetscScalar two(1)
258: PetscScalar val(1)
259: Vec DE,DI
260: zero(1) = 0
261: one(1) = 1
262: two(1) = 2.0d0
265: ! fix indices on matsetvalues
266: call TaoGetDualVariables(tao,DE,DI,ierr)
267: CHKERRQ(ierr)
269: call VecGetArray(DE,de_v,de_i,ierr)
270: CHKERRQ(ierr)
271: call VecGetArray(DI,di_v,di_i,ierr)
272: CHKERRQ(ierr)
274: val(1)=2.0d0 * (1.0d0 + de_v(de_i) + di_v(di_i) - di_v(di_i+1))
276: call VecRestoreArray(DE,de_v,de_i,ierr)
277: CHKERRQ(ierr)
278: call VecRestoreArray(DI,di_v,di_i,ierr)
279: CHKERRQ(ierr)
281: call MatSetValues(H,1,zero,1,zero,val,INSERT_VALUES,ierr)
282: CHKERRQ(ierr)
283: call MatSetValues(H,1,one,1,one,two,INSERT_VALUES,ierr)
284: CHKERRQ(ierr)
286: call MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY,ierr)
287: CHKERRQ(ierr)
288: call MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY,ierr)
289: CHKERRQ(ierr)
291: flag = SAME_NONZERO_PATTERN
292: 0
293: end subroutine FormHessian
295: subroutine FormInequalityConstraints(tao,X,C,dummy,ierr)
296: implicit none
297: #include toyf.h
298: Tao tao
299: Vec X,C
300: PetscInt dummy
301: PetscErrorCode ierr
302: PetscScalar x_v(0:1),c_v(0:1)
303: PetscOffset x_i,c_i
305: call VecGetArray(X,x_v,x_i,ierr)
306: CHKERRQ(ierr)
307: call VecGetArray(C,c_v,c_i,ierr)
308: CHKERRQ(ierr)
309: c_v(c_i) = x_v(x_i)*x_v(x_i) - x_v(x_i+1)
310: c_v(c_i+1) = -x_v(x_i)*x_v(x_i) + x_v(x_i+1) + 1.0d0
311: call VecRestoreArray(X,x_v,x_i,ierr)
312: CHKERRQ(ierr)
313: call VecRestoreArray(C,c_v,c_i,ierr)
314: CHKERRQ(ierr)
316: 0
317: end subroutine FormInequalityConstraints
320: subroutine FormEqualityConstraints(tao,X,C,dummy,ierr)
321: implicit none
322: #include toyf.h
323: Tao tao
324: Vec X,C
325: PetscInt dummy
326: PetscErrorCode ierr
327: PetscScalar x_v(0:1),c_v(0:1)
328: PetscOffset x_i,c_i
329: call VecGetArray(X,x_v,x_i,ierr)
330: CHKERRQ(ierr)
331: call VecGetArray(C,c_v,c_i,ierr)
332: CHKERRQ(ierr)
333: c_v(c_i) = x_v(x_i)*x_v(x_i) + x_v(x_i+1) - 2.0d0
334: call VecRestoreArray(X,x_v,x_i,ierr)
335: CHKERRQ(ierr)
336: call VecRestoreArray(C,c_v,c_i,ierr)
337: CHKERRQ(ierr)
338: 0
339: end subroutine FormEqualityConstraints
342: subroutine FormInequalityJacobian(tao,X,JI,JIpre,flag,dummy,ierr)
343: implicit none
344: #include toyf.h
346: Tao tao
347: Vec X
348: Mat JI,JIpre
349: MatStructure flag
350: PetscInt dummy
351: PetscErrorCode ierr
353: PetscInt rows(2)
354: PetscInt cols(2)
355: PetscScalar vals(4),x_v(0:1)
356: PetscOffset x_i
358: call VecGetArray(X,x_v,x_i,ierr)
359: CHKERRQ(ierr)
360: rows(1)=0
361: rows(2) = 1
362: cols(1) = 0
363: cols(2) = 1
364: vals(1) = 2.0*x_v(x_i)
365: vals(2) = -1.0d0
366: vals(3) = -2.0*x_v(x_i)
367: vals(4) = 1.0d0
369: call VecRestoreArray(X,x_v,x_i,ierr)
370: CHKERRQ(ierr)
371: call MatSetValues(JI,2,rows,2,cols,vals,INSERT_VALUES,ierr)
372: CHKERRQ(ierr)
373: call MatAssemblyBegin(JI,MAT_FINAL_ASSEMBLY,ierr)
374: CHKERRQ(ierr)
375: call MatAssemblyEnd(JI,MAT_FINAL_ASSEMBLY,ierr)
376: CHKERRQ(ierr)
377: 0
378: end subroutine FormInequalityJacobian
380: subroutine FormEqualityJacobian(tao,X,JE,JEpre,flag,dummy,ierr)
381: implicit none
382: #include toyf.h
384: Tao tao
385: Vec X
386: Mat JE,JEpre
387: MatStructure flag
388: PetscInt dummy
389: PetscErrorCode ierr
391: PetscInt rows(2)
392: PetscScalar vals(4),x_v(0:1)
393: PetscOffset x_i
395: call VecGetArray(X,x_v,x_i,ierr)
396: CHKERRQ(ierr)
397: rows(1)=0
398: rows(2) = 1
399: vals(1) = 2.0*x_v(x_i)
400: vals(2) = 1.0d0
402: call VecRestoreArray(X,x_v,x_i,ierr)
403: CHKERRQ(ierr)
404: call MatSetValues(JE,1,rows,2,rows,vals,INSERT_VALUES,ierr)
405: CHKERRQ(ierr)
406: call MatAssemblyBegin(JE,MAT_FINAL_ASSEMBLY,ierr)
407: CHKERRQ(ierr)
408: call MatAssemblyEnd(JE,MAT_FINAL_ASSEMBLY,ierr)
409: CHKERRQ(ierr)
410: 0
411: end subroutine FormEqualityJacobian