xref: /petsc/src/tao/leastsquares/tutorials/chwirut2f.F90 (revision f13dfd9ea68e0ddeee984e65c377a1819eab8a8a) !
1!  Program usage: mpiexec -n 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
11!
12! ----------------------------------------------------------------------
13!
14      module chwirut2fmodule
15      use petscmpi              ! or mpi or mpi_f08
16      use petsctao
17#include <petsc/finclude/petsctao.h>
18      PetscReal t(0:213)
19      PetscReal y(0:213)
20      PetscInt  m,n
21      PetscMPIInt  nn
22      PetscMPIInt  rank
23      PetscMPIInt  size
24      PetscMPIInt  idle_tag, die_tag
25      PetscMPIInt  zero,one
26      parameter (m=214)
27      parameter (n=3)
28      parameter (nn=n)
29      parameter (idle_tag=2000)
30      parameter (die_tag=3000)
31      parameter (zero=0,one=1)
32      end module chwirut2fmodule
33
34      program main
35      use chwirut2fmodule
36
37! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
38!                   Variable declarations
39! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
40!
41!  See additional variable declarations in the file chwirut2f.h
42
43      PetscErrorCode   ierr    ! used to check for functions returning nonzeros
44      Vec              x       ! solution vector
45      Vec              f       ! vector of functions
46      Tao        tao     ! Tao context
47
48!  Note: Any user-defined Fortran routines (such as FormGradient)
49!  MUST be declared as external.
50
51      external FormFunction
52
53!  Initialize TAO and PETSc
54      PetscCallA(PetscInitialize(ierr))
55      PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD,size,ierr))
56      PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
57
58!  Initialize problem parameters
59      call InitializeData()
60
61      if (rank .eq. 0) then
62!  Allocate vectors for the solution and gradient
63         PetscCallA(VecCreateSeq(PETSC_COMM_SELF,n,x,ierr))
64         PetscCallA(VecCreateSeq(PETSC_COMM_SELF,m,f,ierr))
65
66!     The TAO code begins here
67
68!     Create TAO solver
69         PetscCallA(TaoCreate(PETSC_COMM_SELF,tao,ierr))
70         PetscCallA(TaoSetType(tao,TAOPOUNDERS,ierr))
71
72!     Set routines for function, gradient, and hessian evaluation
73         PetscCallA(TaoSetResidualRoutine(tao,f,FormFunction,0,ierr))
74
75!     Optional: Set initial guess
76         call FormStartingPoint(x)
77         PetscCallA(TaoSetSolution(tao, x, ierr))
78
79!     Check for TAO command line options
80         PetscCallA(TaoSetFromOptions(tao,ierr))
81!     SOLVE THE APPLICATION
82         PetscCallA(TaoSolve(tao,ierr))
83
84!     Free TAO data structures
85         PetscCallA(TaoDestroy(tao,ierr))
86
87!     Free PETSc data structures
88         PetscCallA(VecDestroy(x,ierr))
89         PetscCallA(VecDestroy(f,ierr))
90         PetscCallA(StopWorkers(ierr))
91
92      else
93         PetscCallA(TaskWorker(ierr))
94      endif
95
96      PetscCallA(PetscFinalize(ierr))
97      end
98
99! --------------------------------------------------------------------
100!  FormFunction - Evaluates the function f(X) and gradient G(X)
101!
102!  Input Parameters:
103!  tao - the Tao context
104!  X   - input vector
105!  dummy - not used
106!
107!  Output Parameters:
108!  f - function vector
109
110      subroutine FormFunction(tao, x, f, dummy, ierr)
111      use chwirut2fmodule
112
113      Tao        tao
114      Vec              x,f
115      PetscErrorCode   ierr
116
117      PetscInt         i,checkedin
118      PetscInt         finished_tasks
119      PetscMPIInt      next_task
120      PetscMPIInt      status(MPI_STATUS_SIZE),tag,source
121      PetscInt         dummy
122
123      PetscReal, pointer :: f_v(:),x_v(:)
124      PetscReal          fval(1)
125
126      ierr = 0
127
128!     Get pointers to vector data
129      PetscCall(VecGetArrayReadF90(x,x_v,ierr))
130      PetscCall(VecGetArrayF90(f,f_v,ierr))
131
132!     Compute F(X)
133      if (size .eq. 1) then
134         ! Single processor
135         do i=1,m
136            PetscCall(RunSimulation(x_v,i,f_v(i),ierr))
137         enddo
138      else
139         ! Multiprocessor main
140         next_task = zero
141         finished_tasks = 0
142         checkedin = 0
143
144         do while (finished_tasks .lt. m .or. checkedin .lt. size-1)
145            PetscCallMPI(MPI_Recv(fval,one,MPIU_SCALAR,MPI_ANY_SOURCE,MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr))
146            tag = status(MPI_TAG)
147            source = status(MPI_SOURCE)
148            if (tag .eq. IDLE_TAG) then
149               checkedin = checkedin + 1
150            else
151               f_v(tag+1) = fval(1)
152               finished_tasks = finished_tasks + 1
153            endif
154            if (next_task .lt. m) then
155               ! Send task to worker
156               PetscCallMPI(MPI_Send(x_v,nn,MPIU_SCALAR,source,next_task,PETSC_COMM_WORLD,ierr))
157               next_task = next_task + one
158            else
159               ! Send idle message to worker
160               PetscCallMPI(MPI_Send(x_v,nn,MPIU_SCALAR,source,IDLE_TAG,PETSC_COMM_WORLD,ierr))
161            end if
162         enddo
163      endif
164
165!     Restore vectors
166      PetscCall(VecRestoreArrayReadF90(x,x_v,ierr))
167      PetscCall(VecRestoreArrayF90(F,f_v,ierr))
168      end
169
170      subroutine FormStartingPoint(x)
171      use chwirut2fmodule
172
173      Vec             x
174      PetscReal, pointer :: x_v(:)
175      PetscErrorCode  ierr
176
177      PetscCall(VecGetArrayF90(x,x_v,ierr))
178      x_v(1) = 0.15
179      x_v(2) = 0.008
180      x_v(3) = 0.01
181      PetscCall(VecRestoreArrayF90(x,x_v,ierr))
182      end
183
184      subroutine InitializeData()
185      use chwirut2fmodule
186
187      PetscInt i
188      i=0
189      y(i) =    92.9000;  t(i) =  0.5000; i=i+1
190      y(i) =    78.7000;  t(i) =   0.6250; i=i+1
191      y(i) =    64.2000;  t(i) =   0.7500; i=i+1
192      y(i) =    64.9000;  t(i) =   0.8750; i=i+1
193      y(i) =    57.1000;  t(i) =   1.0000; i=i+1
194      y(i) =    43.3000;  t(i) =   1.2500; i=i+1
195      y(i) =    31.1000;  t(i) =  1.7500; i=i+1
196      y(i) =    23.6000;  t(i) =  2.2500; i=i+1
197      y(i) =    31.0500;  t(i) =  1.7500; i=i+1
198      y(i) =    23.7750;  t(i) =  2.2500; i=i+1
199      y(i) =    17.7375;  t(i) =  2.7500; i=i+1
200      y(i) =    13.8000;  t(i) =  3.2500; i=i+1
201      y(i) =    11.5875;  t(i) =  3.7500; i=i+1
202      y(i) =     9.4125;  t(i) =  4.2500; i=i+1
203      y(i) =     7.7250;  t(i) =  4.7500; i=i+1
204      y(i) =     7.3500;  t(i) =  5.2500; i=i+1
205      y(i) =     8.0250;  t(i) =  5.7500; i=i+1
206      y(i) =    90.6000;  t(i) =  0.5000; i=i+1
207      y(i) =    76.9000;  t(i) =  0.6250; i=i+1
208      y(i) =    71.6000;  t(i) = 0.7500; i=i+1
209      y(i) =    63.6000;  t(i) =  0.8750; i=i+1
210      y(i) =    54.0000;  t(i) =  1.0000; i=i+1
211      y(i) =    39.2000;  t(i) =  1.2500; i=i+1
212      y(i) =    29.3000;  t(i) = 1.7500; i=i+1
213      y(i) =    21.4000;  t(i) =  2.2500; i=i+1
214      y(i) =    29.1750;  t(i) =  1.7500; i=i+1
215      y(i) =    22.1250;  t(i) =  2.2500; i=i+1
216      y(i) =    17.5125;  t(i) =  2.7500; i=i+1
217      y(i) =    14.2500;  t(i) =  3.2500; i=i+1
218      y(i) =     9.4500;  t(i) =  3.7500; i=i+1
219      y(i) =     9.1500;  t(i) =  4.2500; i=i+1
220      y(i) =     7.9125;  t(i) =  4.7500; i=i+1
221      y(i) =     8.4750;  t(i) =  5.2500; i=i+1
222      y(i) =     6.1125;  t(i) =  5.7500; i=i+1
223      y(i) =    80.0000;  t(i) =  0.5000; i=i+1
224      y(i) =    79.0000;  t(i) =  0.6250; i=i+1
225      y(i) =    63.8000;  t(i) =  0.7500; i=i+1
226      y(i) =    57.2000;  t(i) =  0.8750; i=i+1
227      y(i) =    53.2000;  t(i) =  1.0000; i=i+1
228      y(i) =    42.5000;  t(i) =  1.2500; i=i+1
229      y(i) =    26.8000;  t(i) =  1.7500; i=i+1
230      y(i) =    20.4000;  t(i) =  2.2500; i=i+1
231      y(i) =    26.8500;  t(i) =   1.7500; i=i+1
232      y(i) =    21.0000;  t(i) =   2.2500; i=i+1
233      y(i) =    16.4625;  t(i) =   2.7500; i=i+1
234      y(i) =    12.5250;  t(i) =   3.2500; i=i+1
235      y(i) =    10.5375;  t(i) =   3.7500; i=i+1
236      y(i) =     8.5875;  t(i) =   4.2500; i=i+1
237      y(i) =     7.1250;  t(i) =   4.7500; i=i+1
238      y(i) =     6.1125;  t(i) =   5.2500; i=i+1
239      y(i) =     5.9625;  t(i) =   5.7500; i=i+1
240      y(i) =    74.1000;  t(i) =   0.5000; i=i+1
241      y(i) =    67.3000;  t(i) =   0.6250; i=i+1
242      y(i) =    60.8000;  t(i) =   0.7500; i=i+1
243      y(i) =    55.5000;  t(i) =   0.8750; i=i+1
244      y(i) =    50.3000;  t(i) =   1.0000; i=i+1
245      y(i) =    41.0000;  t(i) =   1.2500; i=i+1
246      y(i) =    29.4000;  t(i) =   1.7500; i=i+1
247      y(i) =    20.4000;  t(i) =   2.2500; i=i+1
248      y(i) =    29.3625;  t(i) =   1.7500; i=i+1
249      y(i) =    21.1500;  t(i) =   2.2500; i=i+1
250      y(i) =    16.7625;  t(i) =   2.7500; i=i+1
251      y(i) =    13.2000;  t(i) =   3.2500; i=i+1
252      y(i) =    10.8750;  t(i) =   3.7500; i=i+1
253      y(i) =     8.1750;  t(i) =   4.2500; i=i+1
254      y(i) =     7.3500;  t(i) =   4.7500; i=i+1
255      y(i) =     5.9625;  t(i) =  5.2500; i=i+1
256      y(i) =     5.6250;  t(i) =   5.7500; i=i+1
257      y(i) =    81.5000;  t(i) =    .5000; i=i+1
258      y(i) =    62.4000;  t(i) =    .7500; i=i+1
259      y(i) =    32.5000;  t(i) =   1.5000; i=i+1
260      y(i) =    12.4100;  t(i) =   3.0000; i=i+1
261      y(i) =    13.1200;  t(i) =   3.0000; i=i+1
262      y(i) =    15.5600;  t(i) =   3.0000; i=i+1
263      y(i) =     5.6300;  t(i) =   6.0000; i=i+1
264      y(i) =    78.0000;  t(i) =   .5000; i=i+1
265      y(i) =    59.9000;  t(i) =    .7500; i=i+1
266      y(i) =    33.2000;  t(i) =   1.5000; i=i+1
267      y(i) =    13.8400;  t(i) =   3.0000; i=i+1
268      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
269      y(i) =    14.6200;  t(i) =   3.0000; i=i+1
270      y(i) =     3.9400;  t(i) =   6.0000; i=i+1
271      y(i) =    76.8000;  t(i) =    .5000; i=i+1
272      y(i) =    61.0000;  t(i) =    .7500; i=i+1
273      y(i) =    32.9000;  t(i) =   1.5000; i=i+1
274      y(i) =    13.8700;  t(i) = 3.0000; i=i+1
275      y(i) =    11.8100;  t(i) =   3.0000; i=i+1
276      y(i) =    13.3100;  t(i) =   3.0000; i=i+1
277      y(i) =     5.4400;  t(i) =   6.0000; i=i+1
278      y(i) =    78.0000;  t(i) =    .5000; i=i+1
279      y(i) =    63.5000;  t(i) =    .7500; i=i+1
280      y(i) =    33.8000;  t(i) =   1.5000; i=i+1
281      y(i) =    12.5600;  t(i) =   3.0000; i=i+1
282      y(i) =     5.6300;  t(i) =   6.0000; i=i+1
283      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
284      y(i) =    13.1200;  t(i) =   3.0000; i=i+1
285      y(i) =     5.4400;  t(i) =   6.0000; i=i+1
286      y(i) =    76.8000;  t(i) =    .5000; i=i+1
287      y(i) =    60.0000;  t(i) =    .7500; i=i+1
288      y(i) =    47.8000;  t(i) =   1.0000; i=i+1
289      y(i) =    32.0000;  t(i) =   1.5000; i=i+1
290      y(i) =    22.2000;  t(i) =   2.0000; i=i+1
291      y(i) =    22.5700;  t(i) =   2.0000; i=i+1
292      y(i) =    18.8200;  t(i) =   2.5000; i=i+1
293      y(i) =    13.9500;  t(i) =   3.0000; i=i+1
294      y(i) =    11.2500;  t(i) =   4.0000; i=i+1
295      y(i) =     9.0000;  t(i) =   5.0000; i=i+1
296      y(i) =     6.6700;  t(i) =   6.0000; i=i+1
297      y(i) =    75.8000;  t(i) =    .5000; i=i+1
298      y(i) =    62.0000;  t(i) =    .7500; i=i+1
299      y(i) =    48.8000;  t(i) =   1.0000; i=i+1
300      y(i) =    35.2000;  t(i) =   1.5000; i=i+1
301      y(i) =    20.0000;  t(i) =   2.0000; i=i+1
302      y(i) =    20.3200;  t(i) =   2.0000; i=i+1
303      y(i) =    19.3100;  t(i) =   2.5000; i=i+1
304      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
305      y(i) =    10.4200;  t(i) =   4.0000; i=i+1
306      y(i) =     7.3100;  t(i) =   5.0000; i=i+1
307      y(i) =     7.4200;  t(i) =   6.0000; i=i+1
308      y(i) =    70.5000;  t(i) =    .5000; i=i+1
309      y(i) =    59.5000;  t(i) =    .7500; i=i+1
310      y(i) =    48.5000;  t(i) =   1.0000; i=i+1
311      y(i) =    35.8000;  t(i) =   1.5000; i=i+1
312      y(i) =    21.0000;  t(i) =   2.0000; i=i+1
313      y(i) =    21.6700;  t(i) =   2.0000; i=i+1
314      y(i) =    21.0000;  t(i) =   2.5000; i=i+1
315      y(i) =    15.6400;  t(i) =   3.0000; i=i+1
316      y(i) =     8.1700;  t(i) =   4.0000; i=i+1
317      y(i) =     8.5500;  t(i) =   5.0000; i=i+1
318      y(i) =    10.1200;  t(i) =   6.0000; i=i+1
319      y(i) =    78.0000;  t(i) =    .5000; i=i+1
320      y(i) =    66.0000;  t(i) =    .6250; i=i+1
321      y(i) =    62.0000;  t(i) =    .7500; i=i+1
322      y(i) =    58.0000;  t(i) =    .8750; i=i+1
323      y(i) =    47.7000;  t(i) =   1.0000; i=i+1
324      y(i) =    37.8000;  t(i) =   1.2500; i=i+1
325      y(i) =    20.2000;  t(i) =   2.2500; i=i+1
326      y(i) =    21.0700;  t(i) =   2.2500; i=i+1
327      y(i) =    13.8700;  t(i) =   2.7500; i=i+1
328      y(i) =     9.6700;  t(i) =   3.2500; i=i+1
329      y(i) =     7.7600;  t(i) =   3.7500; i=i+1
330      y(i) =     5.4400;  t(i) =  4.2500; i=i+1
331      y(i) =     4.8700;  t(i) =  4.7500; i=i+1
332      y(i) =     4.0100;  t(i) =   5.2500; i=i+1
333      y(i) =     3.7500;  t(i) =   5.7500; i=i+1
334      y(i) =    24.1900;  t(i) =   3.0000; i=i+1
335      y(i) =    25.7600;  t(i) =   3.0000; i=i+1
336      y(i) =    18.0700;  t(i) =   3.0000; i=i+1
337      y(i) =    11.8100;  t(i) =   3.0000; i=i+1
338      y(i) =    12.0700;  t(i) =   3.0000; i=i+1
339      y(i) =    16.1200;  t(i) =   3.0000; i=i+1
340      y(i) =    70.8000;  t(i) =    .5000; i=i+1
341      y(i) =    54.7000;  t(i) =    .7500; i=i+1
342      y(i) =    48.0000;  t(i) =   1.0000; i=i+1
343      y(i) =    39.8000;  t(i) =   1.5000; i=i+1
344      y(i) =    29.8000;  t(i) =   2.0000; i=i+1
345      y(i) =    23.7000;  t(i) =   2.5000; i=i+1
346      y(i) =    29.6200;  t(i) =   2.0000; i=i+1
347      y(i) =    23.8100;  t(i) =   2.5000; i=i+1
348      y(i) =    17.7000;  t(i) =   3.0000; i=i+1
349      y(i) =    11.5500;  t(i) =   4.0000; i=i+1
350      y(i) =    12.0700;  t(i) =   5.0000; i=i+1
351      y(i) =     8.7400;  t(i) =   6.0000; i=i+1
352      y(i) =    80.7000;  t(i) =    .5000; i=i+1
353      y(i) =    61.3000;  t(i) =    .7500; i=i+1
354      y(i) =    47.5000;  t(i) =   1.0000; i=i+1
355      y(i) =    29.0000;  t(i) =   1.5000; i=i+1
356      y(i) =    24.0000;  t(i) =   2.0000; i=i+1
357      y(i) =    17.7000;  t(i) =   2.5000; i=i+1
358      y(i) =    24.5600;  t(i) =   2.0000; i=i+1
359      y(i) =    18.6700;  t(i) =   2.5000; i=i+1
360      y(i) =    16.2400;  t(i) =   3.0000; i=i+1
361      y(i) =     8.7400;  t(i) =   4.0000; i=i+1
362      y(i) =     7.8700;  t(i) =   5.0000; i=i+1
363      y(i) =     8.5100;  t(i) =   6.0000; i=i+1
364      y(i) =    66.7000;  t(i) =    .5000; i=i+1
365      y(i) =    59.2000;  t(i) =    .7500; i=i+1
366      y(i) =    40.8000;  t(i) =   1.0000; i=i+1
367      y(i) =    30.7000;  t(i) =   1.5000; i=i+1
368      y(i) =    25.7000;  t(i) =   2.0000; i=i+1
369      y(i) =    16.3000;  t(i) =   2.5000; i=i+1
370      y(i) =    25.9900;  t(i) =   2.0000; i=i+1
371      y(i) =    16.9500;  t(i) =   2.5000; i=i+1
372      y(i) =    13.3500;  t(i) =   3.0000; i=i+1
373      y(i) =     8.6200;  t(i) =   4.0000; i=i+1
374      y(i) =     7.2000;  t(i) =   5.0000; i=i+1
375      y(i) =     6.6400;  t(i) =   6.0000; i=i+1
376      y(i) =    13.6900;  t(i) =   3.0000; i=i+1
377      y(i) =    81.0000;  t(i) =    .5000; i=i+1
378      y(i) =    64.5000;  t(i) =    .7500; i=i+1
379      y(i) =    35.5000;  t(i) =   1.5000; i=i+1
380      y(i) =    13.3100;  t(i) =   3.0000; i=i+1
381      y(i) =     4.8700;  t(i) =   6.0000; i=i+1
382      y(i) =    12.9400;  t(i) =   3.0000; i=i+1
383      y(i) =     5.0600;  t(i) =   6.0000; i=i+1
384      y(i) =    15.1900;  t(i) =   3.0000; i=i+1
385      y(i) =    14.6200;  t(i) =   3.0000; i=i+1
386      y(i) =    15.6400;  t(i) =   3.0000; i=i+1
387      y(i) =    25.5000;  t(i) =   1.7500; i=i+1
388      y(i) =    25.9500;  t(i) =   1.7500; i=i+1
389      y(i) =    81.7000;  t(i) =    .5000; i=i+1
390      y(i) =    61.6000;  t(i) =    .7500; i=i+1
391      y(i) =    29.8000;  t(i) =   1.7500; i=i+1
392      y(i) =    29.8100;  t(i) =   1.7500; i=i+1
393      y(i) =    17.1700;  t(i) =   2.7500; i=i+1
394      y(i) =    10.3900;  t(i) =   3.7500; i=i+1
395      y(i) =    28.4000;  t(i) =   1.7500; i=i+1
396      y(i) =    28.6900;  t(i) =   1.7500; i=i+1
397      y(i) =    81.3000;  t(i) =    .5000; i=i+1
398      y(i) =    60.9000;  t(i) =    .7500; i=i+1
399      y(i) =    16.6500;  t(i) =   2.7500; i=i+1
400      y(i) =    10.0500;  t(i) =   3.7500; i=i+1
401      y(i) =    28.9000;  t(i) =   1.7500; i=i+1
402      y(i) =    28.9500;  t(i) =   1.7500; i=i+1
403
404      end
405
406      subroutine TaskWorker(ierr)
407      use chwirut2fmodule
408
409      PetscErrorCode ierr
410      PetscReal x(n),f(1)
411      PetscMPIInt tag
412      PetscInt index
413      PetscMPIInt status(MPI_STATUS_SIZE)
414
415      tag = IDLE_TAG
416      f   = 0.0
417      ! Send check-in message to rank-0
418      PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,IDLE_TAG,PETSC_COMM_WORLD,ierr))
419      do while (tag .ne. DIE_TAG)
420         PetscCallMPI(MPI_Recv(x,nn,MPIU_SCALAR,zero,MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr))
421         tag = status(MPI_TAG)
422         if (tag .eq. IDLE_TAG) then
423            PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,IDLE_TAG,PETSC_COMM_WORLD,ierr))
424         else if (tag .ne. DIE_TAG) then
425            index = tag
426            ! Compute local part of residual
427            PetscCall(RunSimulation(x,index,f(1),ierr))
428
429            ! Return residual to rank-0
430            PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,tag,PETSC_COMM_WORLD,ierr))
431         end if
432      enddo
433      ierr = 0
434      end
435
436      subroutine RunSimulation(x,i,f,ierr)
437      use chwirut2fmodule
438
439      PetscReal x(n),f
440      PetscInt i
441      PetscErrorCode ierr
442      f = y(i) - exp(-x(1)*t(i))/(x(2)+x(3)*t(i))
443      ierr = 0
444      end
445
446      subroutine StopWorkers(ierr)
447      use chwirut2fmodule
448
449      integer checkedin
450      PetscMPIInt status(MPI_STATUS_SIZE)
451      PetscMPIInt source
452      PetscReal f(1),x(n)
453      PetscErrorCode ierr
454      PetscInt i
455
456      checkedin=0
457      do while (checkedin .lt. size-1)
458         PetscCallMPI(MPI_Recv(f,one,MPIU_SCALAR,MPI_ANY_SOURCE,MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr))
459         checkedin=checkedin+1
460         source = status(MPI_SOURCE)
461         do i=1,n
462           x(i) = 0.0
463         enddo
464         PetscCallMPI(MPI_Send(x,nn,MPIU_SCALAR,source,DIE_TAG,PETSC_COMM_WORLD,ierr))
465      enddo
466      ierr = 0
467      end
468
469!/*TEST
470!
471!   build:
472!      requires: !complex
473!
474!   test:
475!      nsize: 3
476!      args: -tao_monitor_short -tao_max_it 100 -tao_type pounders -tao_gatol 1.e-5
477!      requires: !single
478!
479!
480!TEST*/
481