Actual source code: toyf.F90

petsc-3.13.6 2020-09-29
Report Typos and Errors
  1: ! Program usage: mpiexec -n 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:       module toymodule
 11: #include "petsc/finclude/petsctao.h"
 12:       use petsctao

 14:       Vec x0,xl,xu
 15:       Vec ce,ci,bl,bu
 16:       Mat Ae,Ai,Hess
 17:       PetscInt n,ne,ni
 18:       end module

 20:       program toyf
 21:       use toymodule
 22:       implicit none

 24:       PetscErrorCode       ierr
 25:       Tao                  tao
 26:       KSP                  ksp
 27:       PC                   pc
 28: !      PetscReal            zero

 30:       external FormFunctionGradient,FormHessian
 31:       external FormInequalityConstraints,FormEqualityConstraints
 32:       external FormInequalityJacobian,FormEqualityJacobian


 35:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 36:       if (ierr .ne. 0) then
 37:          print*,'Unable to initialize PETSc'
 38:          stop
 39:       endif

 41:       call PetscPrintf(PETSC_COMM_SELF,'Solution should be f(1,1)=-2\n',ierr);CHKERRA(ierr)

 43:       call InitializeProblem(ierr);CHKERRA(ierr)

 45:       call TaoCreate(PETSC_COMM_SELF,tao,ierr);CHKERRA(ierr)
 46:       call TaoSetType(tao,TAOIPM,ierr);CHKERRA(ierr)
 47:       call TaoSetInitialVector(tao,x0,ierr);CHKERRA(ierr)
 48:       call TaoSetVariableBounds(tao,xl,xu,ierr);CHKERRA(ierr)
 49:       call TaoSetObjectiveAndGradientRoutine(tao,FormFunctionGradient,0,ierr);CHKERRA(ierr)
 50:       call TaoSetEqualityConstraintsRoutine(tao,ce,FormEqualityConstraints,0,ierr);CHKERRA(ierr)
 51:       call TaoSetInequalityConstraintsRoutine(tao,ci,FormInequalityConstraints,0,ierr);CHKERRA(ierr)
 52:       call TaoSetJacobianEqualityRoutine(tao,Ae,Ae,FormEqualityJacobian,0,ierr);CHKERRA(ierr)
 53:       call TaoSetJacobianInequalityRoutine(tao,Ai,Ai,FormInequalityJacobian,0,ierr);CHKERRA(ierr)
 54:       call TaoSetHessianRoutine(tao,Hess,Hess,FormHessian,0,ierr);CHKERRA(ierr)

 56:       call TaoSetFromOptions(tao,ierr);CHKERRA(ierr)
 57:       call TaoGetKSP(tao,ksp,ierr);CHKERRA(ierr)
 58:       call KSPGetPC(ksp,pc,ierr);CHKERRA(ierr)
 59:       call PCSetType(pc,PCLU,ierr);CHKERRA(ierr)
 60:       call PCFactorSetMatSolverType(pc,MATSOLVERSUPERLU,ierr);CHKERRA(ierr)
 61:       call KSPSetType(ksp,KSPPREONLY,ierr);CHKERRA(ierr)
 62:       call KSPSetFromOptions(ksp,ierr);CHKERRA(ierr)

 64: !      zero = 0;
 65: !      call TaoSetTolerances(tao,zero,zero,zero,ierr);CHKERRA(ierr)

 67:       ! Solve
 68:       call TaoSolve(tao,ierr);CHKERRA(ierr)

 70:       ! Finalize Memory
 71:       call DestroyProblem(ierr);CHKERRA(ierr)

 73:       call TaoDestroy(tao,ierr);CHKERRA(ierr)
 74:       call PetscFinalize(ierr)

 76:       stop
 77:       end program toyf


 80:       subroutine InitializeProblem(ierr)
 81:       use toymodule
 82:       implicit none
 83:       PetscReal zero,minus1,two,one
 84:       PetscInt done
 85:       PetscErrorCode ierr
 86:       n = 2
 87:       zero = 0
 88:       minus1 = -1
 89:       two= 2
 90:       one = 1
 91:       done = 1

 93:       call VecCreateSeq(PETSC_COMM_SELF,n,x0,ierr);CHKERRQ(ierr)
 94:       call VecDuplicate(x0,xl,ierr);CHKERRQ(ierr)
 95:       call VecDuplicate(x0,xu,ierr);CHKERRQ(ierr)
 96:       call VecSet(x0,zero,ierr);CHKERRQ(ierr)
 97:       call VecSet(xl,minus1,ierr);CHKERRQ(ierr)
 98:       call VecSet(xu,two,ierr);CHKERRQ(ierr)

100:       ne = 1
101:       call VecCreateSeq(PETSC_COMM_SELF,ne,ce,ierr);CHKERRQ(ierr)

103:       ni = 2
104:       call VecCreateSeq(PETSC_COMM_SELF,ni,ci,ierr);CHKERRQ(ierr)

106:       call MatCreateSeqAIJ(PETSC_COMM_SELF,ne,n,n,PETSC_NULL_INTEGER,Ae,ierr);CHKERRQ(ierr)
107:       call MatCreateSeqAIJ(PETSC_COMM_SELF,ni,n,n,PETSC_NULL_INTEGER,Ai,ierr);CHKERRQ(ierr)
108:       call MatSetFromOptions(Ae,ierr);CHKERRQ(ierr)
109:       call MatSetFromOptions(Ai,ierr);CHKERRQ(ierr)


112:       call MatCreateSeqAIJ(PETSC_COMM_SELF,n,n,done,PETSC_NULL_INTEGER,Hess,ierr);CHKERRQ(ierr)
113:       call MatSetFromOptions(Hess,ierr);CHKERRQ(ierr)
114:       0
115:       end subroutine InitializeProblem


118:       subroutine DestroyProblem(ierr)
119:       use toymodule
120:       implicit none

122:       PetscErrorCode ierr

124:       call MatDestroy(Ae,ierr);CHKERRQ(ierr)
125:       call MatDestroy(Ai,ierr);CHKERRQ(ierr)
126:       call MatDestroy(Hess,ierr);CHKERRQ(ierr)

128:       call VecDestroy(x0,ierr);CHKERRQ(ierr)
129:       call VecDestroy(ce,ierr);CHKERRQ(ierr)
130:       call VecDestroy(ci,ierr);CHKERRQ(ierr)
131:       call VecDestroy(xl,ierr);CHKERRQ(ierr)
132:       call VecDestroy(xu,ierr);CHKERRQ(ierr)
133:       0
134:       end subroutine DestroyProblem

136:       subroutine FormFunctionGradient(tao, X, f, G, dummy, ierr)
137:       use toymodule
138:       implicit none

140:       PetscErrorCode ierr
141:       PetscInt dummy
142:       Vec X,G
143:       Tao tao
144:       PetscScalar f
145:       PetscScalar x_v(0:1),g_v(0:1)
146:       PetscOffset x_i,g_i


149:       call VecGetArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
150:       call VecGetArray(G,g_v,g_i,ierr);CHKERRQ(ierr)
151:       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)-2.0*(x_v(x_i)+x_v(x_i+1))
152:       g_v(g_i) = 2.0*(x_v(x_i)-2.0) - 2.0
153:       g_v(g_i+1) = 2.0*(x_v(x_i+1)-2.0) - 2.0
154:       call VecRestoreArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
155:       call VecRestoreArray(G,g_v,g_i,ierr);CHKERRQ(ierr)
156:       0
157:       end subroutine FormFunctionGradient


160:       subroutine FormHessian(tao,X,H,Hpre,dummy,ierr)
161:       use toymodule
162:       implicit none

164:       Tao        tao
165:       Vec              X
166:       Mat              H, Hpre
167:       PetscErrorCode   ierr
168:       PetscInt         dummy

170:       PetscScalar      de_v(0:1),di_v(0:1)
171:       PetscOffset      de_i,di_i
172:       PetscInt         zero(1),ones
173:       PetscInt         one(1)
174:       PetscScalar      two(1)
175:       PetscScalar      val(1)
176:       Vec DE,DI
177:       zero(1) = 0
178:       one(1) = 1
179:       two(1) = 2.0d0
180:       ones = 1


183:       ! fix indices on matsetvalues
184:       call TaoGetDualVariables(tao,DE,DI,ierr);CHKERRQ(ierr)

186:       call VecGetArrayRead(DE,de_v,de_i,ierr);CHKERRQ(ierr)
187:       call VecGetArrayRead(DI,di_v,di_i,ierr);CHKERRQ(ierr)

189:       val(1)=2 * (1 + de_v(de_i) + di_v(di_i) - di_v(di_i+1))

191:       call VecRestoreArrayRead(DE,de_v,de_i,ierr);CHKERRQ(ierr)
192:       call VecRestoreArrayRead(DI,di_v,di_i,ierr);CHKERRQ(ierr)

194:       call MatSetValues(H,ones,zero,ones,zero,val,INSERT_VALUES,ierr);CHKERRQ(ierr)
195:       call MatSetValues(H,ones,one,ones,one,two,INSERT_VALUES,ierr);CHKERRQ(ierr)

197:       call MatAssemblyBegin(H,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
198:       call MatAssemblyEnd(H,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)

200:       0
201:       end subroutine FormHessian

203:       subroutine FormInequalityConstraints(tao,X,C,dummy,ierr)
204:       use toymodule
205:       implicit none

207:       Tao      tao
208:       Vec            X,C
209:       PetscInt       dummy
210:       PetscErrorCode ierr
211:       PetscScalar    x_v(0:1),c_v(0:1)
212:       PetscOffset    x_i,c_i

214:       call VecGetArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
215:       call VecGetArray(C,c_v,c_i,ierr);CHKERRQ(ierr)
216:       c_v(c_i) = x_v(x_i)*x_v(x_i) - x_v(x_i+1)
217:       c_v(c_i+1) = -x_v(x_i)*x_v(x_i) + x_v(x_i+1) + 1
218:       call VecRestoreArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
219:       call VecRestoreArray(C,c_v,c_i,ierr);CHKERRQ(ierr)

221:       0
222:       end subroutine FormInequalityConstraints


225:       subroutine FormEqualityConstraints(tao,X,C,dummy,ierr)
226:       use toymodule
227:       implicit none

229:       Tao      tao
230:       Vec            X,C
231:       PetscInt       dummy
232:       PetscErrorCode ierr
233:       PetscScalar    x_v(0:1),c_v(0:1)
234:       PetscOffset    x_i,c_i
235:       call VecGetArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
236:       call VecGetArray(C,c_v,c_i,ierr);CHKERRQ(ierr)
237:       c_v(c_i) = x_v(x_i)*x_v(x_i) + x_v(x_i+1) - 2
238:       call VecRestoreArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
239:       call VecRestoreArray(C,c_v,c_i,ierr);CHKERRQ(ierr)
240:       0
241:       end subroutine FormEqualityConstraints


244:       subroutine FormInequalityJacobian(tao,X,JI,JIpre,dummy,ierr)
245:       use toymodule
246:       implicit none

248:       Tao       tao
249:       Vec             X
250:       Mat             JI,JIpre
251:       PetscInt        dummy
252:       PetscErrorCode  ierr

254:       PetscInt        rows(2),two
255:       PetscInt        cols(2)
256:       PetscScalar     vals(4),x_v(0:1)
257:       PetscOffset     x_i

259:       two = 2
260:       call VecGetArrayRead(X,x_v,x_i,ierr)
261:       CHKERRQ(ierr)
262:       rows(1)=0
263:       rows(2) = 1
264:       cols(1) = 0
265:       cols(2) = 1
266:       vals(1) = 2*x_v(x_i)
267:       vals(2) = -1
268:       vals(3) = -2*x_v(x_i)
269:       vals(4) = 1

271:       call VecRestoreArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
272:       call MatSetValues(JI,two,rows,two,cols,vals,INSERT_VALUES,ierr);CHKERRQ(ierr)
273:       call MatAssemblyBegin(JI,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
274:       call MatAssemblyEnd(JI,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
275:       0
276:       end subroutine FormInequalityJacobian

278:       subroutine FormEqualityJacobian(tao,X,JE,JEpre,dummy,ierr)
279:       use toymodule
280:       implicit none

282:       Tao       tao
283:       Vec             X
284:       Mat             JE,JEpre
285:       PetscInt        dummy
286:       PetscErrorCode  ierr

288:       PetscInt        rows(2),one,two
289:       PetscScalar     vals(4),x_v(0:1)
290:       PetscOffset     x_i
291:       one = 1
292:       two = 2
293:       
294:       call VecGetArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
295:       rows(1)=0
296:       rows(2) = 1
297:       vals(1) = 2*x_v(x_i)
298:       vals(2) = 1

300:       call VecRestoreArrayRead(X,x_v,x_i,ierr);CHKERRQ(ierr)
301:       call MatSetValues(JE,one,rows,two,rows,vals,INSERT_VALUES,ierr);CHKERRQ(ierr)
302:       call MatAssemblyBegin(JE,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
303:       call MatAssemblyEnd(JE,MAT_FINAL_ASSEMBLY,ierr);CHKERRQ(ierr)
304:       0
305:       end subroutine FormEqualityJacobian

307: !/*TEST
308: !
309: !   build:
310: !      requires: !complex !single
311: !
312: !   test:
313: !      requires: superlu
314: !      args: -tao_monitor -tao_view -tao_gatol 1.e-5
315: !      filter: Error: grep -v IEEE_DENORMAL
316: !
317: !TEST*/