Actual source code: chwirut2f.F
1: ! Program usage: mpirun -np 1 chwirut1f [-help] [all TAO options]
2: !
3: ! Description: This example demonstrates use of the TAO package to solve a
4: ! nonlinear least-squares problem on a single processor. We minimize the
5: ! Chwirut function:
6: ! sum_{i=0}^{n/2-1} ( alpha*(x_{2i+1}-x_{2i}^2)^2 + (1-x_{2i})^2 )
7: !
8: ! The C version of this code is chwirut1.c
9: !
10: !/*T
11: ! Concepts: TAO - Solving an unconstrained minimization problem
12: ! Routines: TaoInitialize(); TaoFinalize();
13: ! Routines: TaoCreate();
14: ! Routines: TaoSetType();
15: ! Routines: TaoSetSeparableObjectiveRoutine();
16: ! Routines: TaoSetInitialVector();
17: ! Routines: TaoSetFromOptions();
18: ! Routines: TaoSolve();
19: ! Routines: TaoDestroy();
20: ! Processors: n
21: !T*/
22: !
23: ! ----------------------------------------------------------------------
24: !
25: implicit none
27: #include "chwirut2f.h"
29: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
30: ! Variable declarations
31: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
32: !
33: ! See additional variable declarations in the file chwirut2f.h
35: PetscErrorCode ierr ! used to check for functions returning nonzeros
36: Vec x ! solution vector
37: Vec f ! vector of functions
38: TaoSolver tao ! TaoSolver context
39: PetscInt i
41:
44: ! Note: Any user-defined Fortran routines (such as FormGradient)
45: ! MUST be declared as external.
47: external FormFunction
49: ! Initialize TAO and PETSc
50: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
51: call TaoInitialize(PETSC_NULL_CHARACTER,ierr)
53: call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
54: CHKERRQ(ierr)
55: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
56: CHKERRQ(ierr)
58: ! Initialize problem parameters
59: call InitializeData()
60:
61: if (rank .eq. 0) then
62: ! Allocate vectors for the solution and gradient
63: call VecCreateSeq(PETSC_COMM_SELF,n,x,ierr)
64: CHKERRQ(ierr)
65: call VecCreateSeq(PETSC_COMM_SELF,m,f,ierr)
66: CHKERRQ(ierr)
69: ! The TAO code begins here
71: ! Create TAO solver
72: call TaoCreate(PETSC_COMM_SELF,tao,ierr)
73: CHKERRQ(ierr)
74: call TaoSetType(tao,'tao_pounders',ierr)
75: CHKERRQ(ierr)
77: ! Set routines for function, gradient, and hessian evaluation
78: call TaoSetSeparableObjectiveRoutine(tao,f, &
79: & FormFunction,PETSC_NULL_OBJECT,ierr)
80: CHKERRQ(ierr)
82: ! Optional: Set initial guess
83: call FormStartingPoint(x)
84: call TaoSetInitialVector(tao, x, ierr)
85: CHKERRQ(ierr)
88: ! Check for TAO command line options
89: call TaoSetFromOptions(tao,ierr)
90: CHKERRQ(ierr)
91: ! SOLVE THE APPLICATION
92: call TaoSolve(tao,ierr)
93: CHKERRQ(ierr)
95: ! Free TAO data structures
96: call TaoDestroy(tao,ierr)
97: CHKERRQ(ierr)
99: ! Free PETSc data structures
100: call VecDestroy(x,ierr)
101: CHKERRQ(ierr)
102: call VecDestroy(f,ierr)
103: CHKERRQ(ierr)
104: call StopWorkers(ierr)
105: CHKERRQ(ierr)
106:
107: else
108: call TaskWorker(ierr)
109: CHKERRQ(ierr)
110: endif
112: ! Finalize TAO
113: call TaoFinalize(ierr)
114: call PetscFinalize(ierr)
116: end
119: ! --------------------------------------------------------------------
120: ! FormFunction - Evaluates the function f(X) and gradient G(X)
121: !
122: ! Input Parameters:
123: ! tao - the TaoSolver context
124: ! X - input vector
125: ! dummy - not used
126: !
127: ! Output Parameters:
128: ! f - function vector
129:
130: subroutine FormFunction(tao, x, f, dummy, ierr)
131: implicit none
133: ! n,alpha defined in chwirut2f.h
134: #include "chwirut2f.h"
136: TaoSolver tao
137: Vec x,f
138: PetscErrorCode ierr
139: PetscInt dummy
141: PetscInt i,checkedin
142: PetscInt finished_tasks
143: integer next_task,status(MPI_STATUS_SIZE),tag,source
145: ! PETSc's VecGetArray acts differently in Fortran than it does in C.
146: ! Calling VecGetArray((Vec) X, (PetscReal) x_array(0:1), (PetscOffset) x_index, ierr)
147: ! will return an array of doubles referenced by x_array offset by x_index.
148: ! i.e., to reference the kth element of X, use x_array(k + x_index).
149: ! Notice that by declaring the arrays with range (0:1), we are using the C 0-indexing practice.
150: PetscReal f_v(0:1),x_v(0:1),fval
151: PetscOffset f_i,x_i
153: 0
155: ! Get pointers to vector data
156: call VecGetArray(x,x_v,x_i,ierr)
157: CHKERRQ(ierr)
158: call VecGetArray(f,f_v,f_i,ierr)
159: CHKERRQ(ierr)
162: ! Compute F(X)
163: if (size .eq. 1) then
164: ! Single processor
165: do i=0,m-1
166: call RunSimulation(x_v(x_i),i,f_v(i+f_i),ierr)
167: enddo
168: else
169: ! Multiprocessor master
170: next_task = 0
171: finished_tasks = 0
172: checkedin = 0
173:
174: do while (finished_tasks .lt. m .or. checkedin .lt. size-1)
175: call MPI_Recv(fval,1,MPIU_SCALAR,MPI_ANY_SOURCE, &
176: & MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr)
177: tag = status(MPI_TAG)
178: source = status(MPI_SOURCE)
179: if (tag .eq. IDLE_TAG) then
180: checkedin = checkedin + 1
181: else
182: f_v(f_i+tag) = fval
183: finished_tasks = finished_tasks + 1
184: endif
185: if (next_task .lt. m) then
186: ! Send task to worker
187: call MPI_Send(x_v(x_i),n,MPIU_SCALAR,source,next_task, &
188: & PETSC_COMM_WORLD,ierr)
189: next_task = next_task + 1
190: else
191: ! Send idle message to worker
192: call MPI_Send(x_v(x_i),n,MPIU_SCALAR,source,IDLE_TAG, &
193: & PETSC_COMM_WORLD,ierr)
194: end if
195: enddo
196: endif
198: ! Restore vectors
199: call VecRestoreArray(x,x_v,x_i,ierr)
200: CHKERRQ(ierr)
201: call VecRestoreArray(F,f_v,f_i,ierr)
202: CHKERRQ(ierr)
203: return
204: end
210: subroutine FormStartingPoint(x)
211: implicit none
213: ! n,alpha defined in chwirut2f.h
214: #include "chwirut2f.h"
215: Vec x
216: PetscReal x_v(0:1)
217: PetscOffset x_i
218: PetscErrorCode ierr
219:
220: call VecGetArray(x,x_v,x_i,ierr)
221: CHKERRQ(ierr)
222: x_v(x_i) = 0.15d0
223: x_v(x_i+1) = 0.008d0
224: x_v(x_i+2) = 0.01d0
225: call VecRestoreArray(x,x_v,x_i,ierr)
226: CHKERRQ(ierr)
227: return
228: end
231: subroutine InitializeData()
232: implicit none
234: ! n,alpha defined in chwirut2f.h
235: #include "chwirut2f.h"
236: PetscInt i
237: i=0
238: y(i) = 92.9000; t(i) = 0.5000; i=i+1
239: y(i) = 78.7000; t(i) = 0.6250; i=i+1
240: y(i) = 64.2000; t(i) = 0.7500; i=i+1
241: y(i) = 64.9000; t(i) = 0.8750; i=i+1
242: y(i) = 57.1000; t(i) = 1.0000; i=i+1
243: y(i) = 43.3000; t(i) = 1.2500; i=i+1
244: y(i) = 31.1000; t(i) = 1.7500; i=i+1
245: y(i) = 23.6000; t(i) = 2.2500; i=i+1
246: y(i) = 31.0500; t(i) = 1.7500; i=i+1
247: y(i) = 23.7750; t(i) = 2.2500; i=i+1
248: y(i) = 17.7375; t(i) = 2.7500; i=i+1
249: y(i) = 13.8000; t(i) = 3.2500; i=i+1
250: y(i) = 11.5875; t(i) = 3.7500; i=i+1
251: y(i) = 9.4125; t(i) = 4.2500; i=i+1
252: y(i) = 7.7250; t(i) = 4.7500; i=i+1
253: y(i) = 7.3500; t(i) = 5.2500; i=i+1
254: y(i) = 8.0250; t(i) = 5.7500; i=i+1
255: y(i) = 90.6000; t(i) = 0.5000; i=i+1
256: y(i) = 76.9000; t(i) = 0.6250; i=i+1
257: y(i) = 71.6000; t(i) = 0.7500; i=i+1
258: y(i) = 63.6000; t(i) = 0.8750; i=i+1
259: y(i) = 54.0000; t(i) = 1.0000; i=i+1
260: y(i) = 39.2000; t(i) = 1.2500; i=i+1
261: y(i) = 29.3000; t(i) = 1.7500; i=i+1
262: y(i) = 21.4000; t(i) = 2.2500; i=i+1
263: y(i) = 29.1750; t(i) = 1.7500; i=i+1
264: y(i) = 22.1250; t(i) = 2.2500; i=i+1
265: y(i) = 17.5125; t(i) = 2.7500; i=i+1
266: y(i) = 14.2500; t(i) = 3.2500; i=i+1
267: y(i) = 9.4500; t(i) = 3.7500; i=i+1
268: y(i) = 9.1500; t(i) = 4.2500; i=i+1
269: y(i) = 7.9125; t(i) = 4.7500; i=i+1
270: y(i) = 8.4750; t(i) = 5.2500; i=i+1
271: y(i) = 6.1125; t(i) = 5.7500; i=i+1
272: y(i) = 80.0000; t(i) = 0.5000; i=i+1
273: y(i) = 79.0000; t(i) = 0.6250; i=i+1
274: y(i) = 63.8000; t(i) = 0.7500; i=i+1
275: y(i) = 57.2000; t(i) = 0.8750; i=i+1
276: y(i) = 53.2000; t(i) = 1.0000; i=i+1
277: y(i) = 42.5000; t(i) = 1.2500; i=i+1
278: y(i) = 26.8000; t(i) = 1.7500; i=i+1
279: y(i) = 20.4000; t(i) = 2.2500; i=i+1
280: y(i) = 26.8500; t(i) = 1.7500; i=i+1
281: y(i) = 21.0000; t(i) = 2.2500; i=i+1
282: y(i) = 16.4625; t(i) = 2.7500; i=i+1
283: y(i) = 12.5250; t(i) = 3.2500; i=i+1
284: y(i) = 10.5375; t(i) = 3.7500; i=i+1
285: y(i) = 8.5875; t(i) = 4.2500; i=i+1
286: y(i) = 7.1250; t(i) = 4.7500; i=i+1
287: y(i) = 6.1125; t(i) = 5.2500; i=i+1
288: y(i) = 5.9625; t(i) = 5.7500; i=i+1
289: y(i) = 74.1000; t(i) = 0.5000; i=i+1
290: y(i) = 67.3000; t(i) = 0.6250; i=i+1
291: y(i) = 60.8000; t(i) = 0.7500; i=i+1
292: y(i) = 55.5000; t(i) = 0.8750; i=i+1
293: y(i) = 50.3000; t(i) = 1.0000; i=i+1
294: y(i) = 41.0000; t(i) = 1.2500; i=i+1
295: y(i) = 29.4000; t(i) = 1.7500; i=i+1
296: y(i) = 20.4000; t(i) = 2.2500; i=i+1
297: y(i) = 29.3625; t(i) = 1.7500; i=i+1
298: y(i) = 21.1500; t(i) = 2.2500; i=i+1
299: y(i) = 16.7625; t(i) = 2.7500; i=i+1
300: y(i) = 13.2000; t(i) = 3.2500; i=i+1
301: y(i) = 10.8750; t(i) = 3.7500; i=i+1
302: y(i) = 8.1750; t(i) = 4.2500; i=i+1
303: y(i) = 7.3500; t(i) = 4.7500; i=i+1
304: y(i) = 5.9625; t(i) = 5.2500; i=i+1
305: y(i) = 5.6250; t(i) = 5.7500; i=i+1
306: y(i) = 81.5000; t(i) = .5000; i=i+1
307: y(i) = 62.4000; t(i) = .7500; i=i+1
308: y(i) = 32.5000; t(i) = 1.5000; i=i+1
309: y(i) = 12.4100; t(i) = 3.0000; i=i+1
310: y(i) = 13.1200; t(i) = 3.0000; i=i+1
311: y(i) = 15.5600; t(i) = 3.0000; i=i+1
312: y(i) = 5.6300; t(i) = 6.0000; i=i+1
313: y(i) = 78.0000; t(i) = .5000; i=i+1
314: y(i) = 59.9000; t(i) = .7500; i=i+1
315: y(i) = 33.2000; t(i) = 1.5000; i=i+1
316: y(i) = 13.8400; t(i) = 3.0000; i=i+1
317: y(i) = 12.7500; t(i) = 3.0000; i=i+1
318: y(i) = 14.6200; t(i) = 3.0000; i=i+1
319: y(i) = 3.9400; t(i) = 6.0000; i=i+1
320: y(i) = 76.8000; t(i) = .5000; i=i+1
321: y(i) = 61.0000; t(i) = .7500; i=i+1
322: y(i) = 32.9000; t(i) = 1.5000; i=i+1
323: y(i) = 13.8700; t(i) = 3.0000; i=i+1
324: y(i) = 11.8100; t(i) = 3.0000; i=i+1
325: y(i) = 13.3100; t(i) = 3.0000; i=i+1
326: y(i) = 5.4400; t(i) = 6.0000; i=i+1
327: y(i) = 78.0000; t(i) = .5000; i=i+1
328: y(i) = 63.5000; t(i) = .7500; i=i+1
329: y(i) = 33.8000; t(i) = 1.5000; i=i+1
330: y(i) = 12.5600; t(i) = 3.0000; i=i+1
331: y(i) = 5.6300; t(i) = 6.0000; i=i+1
332: y(i) = 12.7500; t(i) = 3.0000; i=i+1
333: y(i) = 13.1200; t(i) = 3.0000; i=i+1
334: y(i) = 5.4400; t(i) = 6.0000; i=i+1
335: y(i) = 76.8000; t(i) = .5000; i=i+1
336: y(i) = 60.0000; t(i) = .7500; i=i+1
337: y(i) = 47.8000; t(i) = 1.0000; i=i+1
338: y(i) = 32.0000; t(i) = 1.5000; i=i+1
339: y(i) = 22.2000; t(i) = 2.0000; i=i+1
340: y(i) = 22.5700; t(i) = 2.0000; i=i+1
341: y(i) = 18.8200; t(i) = 2.5000; i=i+1
342: y(i) = 13.9500; t(i) = 3.0000; i=i+1
343: y(i) = 11.2500; t(i) = 4.0000; i=i+1
344: y(i) = 9.0000; t(i) = 5.0000; i=i+1
345: y(i) = 6.6700; t(i) = 6.0000; i=i+1
346: y(i) = 75.8000; t(i) = .5000; i=i+1
347: y(i) = 62.0000; t(i) = .7500; i=i+1
348: y(i) = 48.8000; t(i) = 1.0000; i=i+1
349: y(i) = 35.2000; t(i) = 1.5000; i=i+1
350: y(i) = 20.0000; t(i) = 2.0000; i=i+1
351: y(i) = 20.3200; t(i) = 2.0000; i=i+1
352: y(i) = 19.3100; t(i) = 2.5000; i=i+1
353: y(i) = 12.7500; t(i) = 3.0000; i=i+1
354: y(i) = 10.4200; t(i) = 4.0000; i=i+1
355: y(i) = 7.3100; t(i) = 5.0000; i=i+1
356: y(i) = 7.4200; t(i) = 6.0000; i=i+1
357: y(i) = 70.5000; t(i) = .5000; i=i+1
358: y(i) = 59.5000; t(i) = .7500; i=i+1
359: y(i) = 48.5000; t(i) = 1.0000; i=i+1
360: y(i) = 35.8000; t(i) = 1.5000; i=i+1
361: y(i) = 21.0000; t(i) = 2.0000; i=i+1
362: y(i) = 21.6700; t(i) = 2.0000; i=i+1
363: y(i) = 21.0000; t(i) = 2.5000; i=i+1
364: y(i) = 15.6400; t(i) = 3.0000; i=i+1
365: y(i) = 8.1700; t(i) = 4.0000; i=i+1
366: y(i) = 8.5500; t(i) = 5.0000; i=i+1
367: y(i) = 10.1200; t(i) = 6.0000; i=i+1
368: y(i) = 78.0000; t(i) = .5000; i=i+1
369: y(i) = 66.0000; t(i) = .6250; i=i+1
370: y(i) = 62.0000; t(i) = .7500; i=i+1
371: y(i) = 58.0000; t(i) = .8750; i=i+1
372: y(i) = 47.7000; t(i) = 1.0000; i=i+1
373: y(i) = 37.8000; t(i) = 1.2500; i=i+1
374: y(i) = 20.2000; t(i) = 2.2500; i=i+1
375: y(i) = 21.0700; t(i) = 2.2500; i=i+1
376: y(i) = 13.8700; t(i) = 2.7500; i=i+1
377: y(i) = 9.6700; t(i) = 3.2500; i=i+1
378: y(i) = 7.7600; t(i) = 3.7500; i=i+1
379: y(i) = 5.4400; t(i) = 4.2500; i=i+1
380: y(i) = 4.8700; t(i) = 4.7500; i=i+1
381: y(i) = 4.0100; t(i) = 5.2500; i=i+1
382: y(i) = 3.7500; t(i) = 5.7500; i=i+1
383: y(i) = 24.1900; t(i) = 3.0000; i=i+1
384: y(i) = 25.7600; t(i) = 3.0000; i=i+1
385: y(i) = 18.0700; t(i) = 3.0000; i=i+1
386: y(i) = 11.8100; t(i) = 3.0000; i=i+1
387: y(i) = 12.0700; t(i) = 3.0000; i=i+1
388: y(i) = 16.1200; t(i) = 3.0000; i=i+1
389: y(i) = 70.8000; t(i) = .5000; i=i+1
390: y(i) = 54.7000; t(i) = .7500; i=i+1
391: y(i) = 48.0000; t(i) = 1.0000; i=i+1
392: y(i) = 39.8000; t(i) = 1.5000; i=i+1
393: y(i) = 29.8000; t(i) = 2.0000; i=i+1
394: y(i) = 23.7000; t(i) = 2.5000; i=i+1
395: y(i) = 29.6200; t(i) = 2.0000; i=i+1
396: y(i) = 23.8100; t(i) = 2.5000; i=i+1
397: y(i) = 17.7000; t(i) = 3.0000; i=i+1
398: y(i) = 11.5500; t(i) = 4.0000; i=i+1
399: y(i) = 12.0700; t(i) = 5.0000; i=i+1
400: y(i) = 8.7400; t(i) = 6.0000; i=i+1
401: y(i) = 80.7000; t(i) = .5000; i=i+1
402: y(i) = 61.3000; t(i) = .7500; i=i+1
403: y(i) = 47.5000; t(i) = 1.0000; i=i+1
404: y(i) = 29.0000; t(i) = 1.5000; i=i+1
405: y(i) = 24.0000; t(i) = 2.0000; i=i+1
406: y(i) = 17.7000; t(i) = 2.5000; i=i+1
407: y(i) = 24.5600; t(i) = 2.0000; i=i+1
408: y(i) = 18.6700; t(i) = 2.5000; i=i+1
409: y(i) = 16.2400; t(i) = 3.0000; i=i+1
410: y(i) = 8.7400; t(i) = 4.0000; i=i+1
411: y(i) = 7.8700; t(i) = 5.0000; i=i+1
412: y(i) = 8.5100; t(i) = 6.0000; i=i+1
413: y(i) = 66.7000; t(i) = .5000; i=i+1
414: y(i) = 59.2000; t(i) = .7500; i=i+1
415: y(i) = 40.8000; t(i) = 1.0000; i=i+1
416: y(i) = 30.7000; t(i) = 1.5000; i=i+1
417: y(i) = 25.7000; t(i) = 2.0000; i=i+1
418: y(i) = 16.3000; t(i) = 2.5000; i=i+1
419: y(i) = 25.9900; t(i) = 2.0000; i=i+1
420: y(i) = 16.9500; t(i) = 2.5000; i=i+1
421: y(i) = 13.3500; t(i) = 3.0000; i=i+1
422: y(i) = 8.6200; t(i) = 4.0000; i=i+1
423: y(i) = 7.2000; t(i) = 5.0000; i=i+1
424: y(i) = 6.6400; t(i) = 6.0000; i=i+1
425: y(i) = 13.6900; t(i) = 3.0000; i=i+1
426: y(i) = 81.0000; t(i) = .5000; i=i+1
427: y(i) = 64.5000; t(i) = .7500; i=i+1
428: y(i) = 35.5000; t(i) = 1.5000; i=i+1
429: y(i) = 13.3100; t(i) = 3.0000; i=i+1
430: y(i) = 4.8700; t(i) = 6.0000; i=i+1
431: y(i) = 12.9400; t(i) = 3.0000; i=i+1
432: y(i) = 5.0600; t(i) = 6.0000; i=i+1
433: y(i) = 15.1900; t(i) = 3.0000; i=i+1
434: y(i) = 14.6200; t(i) = 3.0000; i=i+1
435: y(i) = 15.6400; t(i) = 3.0000; i=i+1
436: y(i) = 25.5000; t(i) = 1.7500; i=i+1
437: y(i) = 25.9500; t(i) = 1.7500; i=i+1
438: y(i) = 81.7000; t(i) = .5000; i=i+1
439: y(i) = 61.6000; t(i) = .7500; i=i+1
440: y(i) = 29.8000; t(i) = 1.7500; i=i+1
441: y(i) = 29.8100; t(i) = 1.7500; i=i+1
442: y(i) = 17.1700; t(i) = 2.7500; i=i+1
443: y(i) = 10.3900; t(i) = 3.7500; i=i+1
444: y(i) = 28.4000; t(i) = 1.7500; i=i+1
445: y(i) = 28.6900; t(i) = 1.7500; i=i+1
446: y(i) = 81.3000; t(i) = .5000; i=i+1
447: y(i) = 60.9000; t(i) = .7500; i=i+1
448: y(i) = 16.6500; t(i) = 2.7500; i=i+1
449: y(i) = 10.0500; t(i) = 3.7500; i=i+1
450: y(i) = 28.9000; t(i) = 1.7500; i=i+1
451: y(i) = 28.9500; t(i) = 1.7500; i=i+1
452:
453: return
454: end
456:
457:
458: subroutine TaskWorker(ierr)
459: implicit none
460: #include "chwirut2f.h"
461: PetscErrorCode ierr
462: PetscReal x(n),f
463: integer tag
464: integer index
465: integer status(MPI_STATUS_SIZE)
466:
467: tag = IDLE_TAG
468: ! Send check-in message to master
469: call MPI_Send(f,1,MPIU_SCALAR,0,IDLE_TAG,PETSC_COMM_WORLD,ierr)
470: CHKERRQ(ierr)
471: do while (tag .ne. DIE_TAG)
472: call MPI_Recv(x,n,MPIU_SCALAR,0,MPI_ANY_TAG,PETSC_COMM_WORLD, &
473: & status,ierr)
474: CHKERRQ(ierr)
475: tag = status(MPI_TAG)
476: if (tag .eq. IDLE_TAG) then
477: call MPI_Send(f,1,MPIU_SCALAR,0,IDLE_TAG,PETSC_COMM_WORLD, &
478: & ierr)
479: CHKERRQ(ierr)
480: else if (tag .ne. DIE_TAG) then
481: index = tag
482: ! Compute local part of residual
483: call RunSimulation(x,index,f,ierr)
484: CHKERRQ(ierr)
485:
486: ! Return residual to master
487: call MPI_Send(f,1,MPIU_SCALAR,0,tag,PETSC_COMM_WORLD,ierr)
488: CHKERRQ(ierr)
489: end if
490: enddo
491: 0
492: return
493: end
497: subroutine RunSimulation(x,i,f,ierr)
498: implicit none
499: #include "chwirut2f.h"
500: PetscReal x(n),f
501: PetscInt i
502: PetscErrorCode ierr
503: f = y(i) - exp(-x(1)*t(i))/(x(2)+x(3)*t(i))
504: 0
505: return
506: end
508: subroutine StopWorkers(ierr)
509: implicit none
510: #include "chwirut2f.h"
511: integer checkedin
512: integer status(MPI_STATUS_SIZE)
513: integer source
514: PetscReal f,x(n)
515: PetscErrorCode ierr
517: checkedin=0
518: do while (checkedin .lt. size-1)
519: call MPI_Recv(f,1,MPIU_SCALAR,MPI_ANY_SOURCE,MPI_ANY_TAG, &
520: & PETSC_COMM_WORLD,status,ierr)
521: CHKERRQ(ierr)
522: checkedin=checkedin+1
523: source = status(MPI_SOURCE)
524: call MPI_Send(x,n,MPIU_SCALAR,source,DIE_TAG,PETSC_COMM_WORLD, &
525: & ierr)
526: CHKERRQ(ierr)
527: enddo
528: ierr=0
529: return
530: end
534: