Actual source code: toyf.F

petsc-dev 2014-02-02
Report Typos and Errors
  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