xref: /petsc/src/tao/leastsquares/tutorials/chwirut2f.F90 (revision d9acb416d05abeed0a33bde3a81aeb2ea0364f6a)
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      return
169      end
170
171      subroutine FormStartingPoint(x)
172      use chwirut2fmodule
173
174      Vec             x
175      PetscReal, pointer :: x_v(:)
176      PetscErrorCode  ierr
177
178      PetscCall(VecGetArrayF90(x,x_v,ierr))
179      x_v(1) = 0.15
180      x_v(2) = 0.008
181      x_v(3) = 0.01
182      PetscCall(VecRestoreArrayF90(x,x_v,ierr))
183      return
184      end
185
186      subroutine InitializeData()
187      use chwirut2fmodule
188
189      PetscInt i
190      i=0
191      y(i) =    92.9000;  t(i) =  0.5000; i=i+1
192      y(i) =    78.7000;  t(i) =   0.6250; i=i+1
193      y(i) =    64.2000;  t(i) =   0.7500; i=i+1
194      y(i) =    64.9000;  t(i) =   0.8750; i=i+1
195      y(i) =    57.1000;  t(i) =   1.0000; i=i+1
196      y(i) =    43.3000;  t(i) =   1.2500; i=i+1
197      y(i) =    31.1000;  t(i) =  1.7500; i=i+1
198      y(i) =    23.6000;  t(i) =  2.2500; i=i+1
199      y(i) =    31.0500;  t(i) =  1.7500; i=i+1
200      y(i) =    23.7750;  t(i) =  2.2500; i=i+1
201      y(i) =    17.7375;  t(i) =  2.7500; i=i+1
202      y(i) =    13.8000;  t(i) =  3.2500; i=i+1
203      y(i) =    11.5875;  t(i) =  3.7500; i=i+1
204      y(i) =     9.4125;  t(i) =  4.2500; i=i+1
205      y(i) =     7.7250;  t(i) =  4.7500; i=i+1
206      y(i) =     7.3500;  t(i) =  5.2500; i=i+1
207      y(i) =     8.0250;  t(i) =  5.7500; i=i+1
208      y(i) =    90.6000;  t(i) =  0.5000; i=i+1
209      y(i) =    76.9000;  t(i) =  0.6250; i=i+1
210      y(i) =    71.6000;  t(i) = 0.7500; i=i+1
211      y(i) =    63.6000;  t(i) =  0.8750; i=i+1
212      y(i) =    54.0000;  t(i) =  1.0000; i=i+1
213      y(i) =    39.2000;  t(i) =  1.2500; i=i+1
214      y(i) =    29.3000;  t(i) = 1.7500; i=i+1
215      y(i) =    21.4000;  t(i) =  2.2500; i=i+1
216      y(i) =    29.1750;  t(i) =  1.7500; i=i+1
217      y(i) =    22.1250;  t(i) =  2.2500; i=i+1
218      y(i) =    17.5125;  t(i) =  2.7500; i=i+1
219      y(i) =    14.2500;  t(i) =  3.2500; i=i+1
220      y(i) =     9.4500;  t(i) =  3.7500; i=i+1
221      y(i) =     9.1500;  t(i) =  4.2500; i=i+1
222      y(i) =     7.9125;  t(i) =  4.7500; i=i+1
223      y(i) =     8.4750;  t(i) =  5.2500; i=i+1
224      y(i) =     6.1125;  t(i) =  5.7500; i=i+1
225      y(i) =    80.0000;  t(i) =  0.5000; i=i+1
226      y(i) =    79.0000;  t(i) =  0.6250; i=i+1
227      y(i) =    63.8000;  t(i) =  0.7500; i=i+1
228      y(i) =    57.2000;  t(i) =  0.8750; i=i+1
229      y(i) =    53.2000;  t(i) =  1.0000; i=i+1
230      y(i) =    42.5000;  t(i) =  1.2500; i=i+1
231      y(i) =    26.8000;  t(i) =  1.7500; i=i+1
232      y(i) =    20.4000;  t(i) =  2.2500; i=i+1
233      y(i) =    26.8500;  t(i) =   1.7500; i=i+1
234      y(i) =    21.0000;  t(i) =   2.2500; i=i+1
235      y(i) =    16.4625;  t(i) =   2.7500; i=i+1
236      y(i) =    12.5250;  t(i) =   3.2500; i=i+1
237      y(i) =    10.5375;  t(i) =   3.7500; i=i+1
238      y(i) =     8.5875;  t(i) =   4.2500; i=i+1
239      y(i) =     7.1250;  t(i) =   4.7500; i=i+1
240      y(i) =     6.1125;  t(i) =   5.2500; i=i+1
241      y(i) =     5.9625;  t(i) =   5.7500; i=i+1
242      y(i) =    74.1000;  t(i) =   0.5000; i=i+1
243      y(i) =    67.3000;  t(i) =   0.6250; i=i+1
244      y(i) =    60.8000;  t(i) =   0.7500; i=i+1
245      y(i) =    55.5000;  t(i) =   0.8750; i=i+1
246      y(i) =    50.3000;  t(i) =   1.0000; i=i+1
247      y(i) =    41.0000;  t(i) =   1.2500; i=i+1
248      y(i) =    29.4000;  t(i) =   1.7500; i=i+1
249      y(i) =    20.4000;  t(i) =   2.2500; i=i+1
250      y(i) =    29.3625;  t(i) =   1.7500; i=i+1
251      y(i) =    21.1500;  t(i) =   2.2500; i=i+1
252      y(i) =    16.7625;  t(i) =   2.7500; i=i+1
253      y(i) =    13.2000;  t(i) =   3.2500; i=i+1
254      y(i) =    10.8750;  t(i) =   3.7500; i=i+1
255      y(i) =     8.1750;  t(i) =   4.2500; i=i+1
256      y(i) =     7.3500;  t(i) =   4.7500; i=i+1
257      y(i) =     5.9625;  t(i) =  5.2500; i=i+1
258      y(i) =     5.6250;  t(i) =   5.7500; i=i+1
259      y(i) =    81.5000;  t(i) =    .5000; i=i+1
260      y(i) =    62.4000;  t(i) =    .7500; i=i+1
261      y(i) =    32.5000;  t(i) =   1.5000; i=i+1
262      y(i) =    12.4100;  t(i) =   3.0000; i=i+1
263      y(i) =    13.1200;  t(i) =   3.0000; i=i+1
264      y(i) =    15.5600;  t(i) =   3.0000; i=i+1
265      y(i) =     5.6300;  t(i) =   6.0000; i=i+1
266      y(i) =    78.0000;  t(i) =   .5000; i=i+1
267      y(i) =    59.9000;  t(i) =    .7500; i=i+1
268      y(i) =    33.2000;  t(i) =   1.5000; i=i+1
269      y(i) =    13.8400;  t(i) =   3.0000; i=i+1
270      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
271      y(i) =    14.6200;  t(i) =   3.0000; i=i+1
272      y(i) =     3.9400;  t(i) =   6.0000; i=i+1
273      y(i) =    76.8000;  t(i) =    .5000; i=i+1
274      y(i) =    61.0000;  t(i) =    .7500; i=i+1
275      y(i) =    32.9000;  t(i) =   1.5000; i=i+1
276      y(i) =    13.8700;  t(i) = 3.0000; i=i+1
277      y(i) =    11.8100;  t(i) =   3.0000; i=i+1
278      y(i) =    13.3100;  t(i) =   3.0000; i=i+1
279      y(i) =     5.4400;  t(i) =   6.0000; i=i+1
280      y(i) =    78.0000;  t(i) =    .5000; i=i+1
281      y(i) =    63.5000;  t(i) =    .7500; i=i+1
282      y(i) =    33.8000;  t(i) =   1.5000; i=i+1
283      y(i) =    12.5600;  t(i) =   3.0000; i=i+1
284      y(i) =     5.6300;  t(i) =   6.0000; i=i+1
285      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
286      y(i) =    13.1200;  t(i) =   3.0000; i=i+1
287      y(i) =     5.4400;  t(i) =   6.0000; i=i+1
288      y(i) =    76.8000;  t(i) =    .5000; i=i+1
289      y(i) =    60.0000;  t(i) =    .7500; i=i+1
290      y(i) =    47.8000;  t(i) =   1.0000; i=i+1
291      y(i) =    32.0000;  t(i) =   1.5000; i=i+1
292      y(i) =    22.2000;  t(i) =   2.0000; i=i+1
293      y(i) =    22.5700;  t(i) =   2.0000; i=i+1
294      y(i) =    18.8200;  t(i) =   2.5000; i=i+1
295      y(i) =    13.9500;  t(i) =   3.0000; i=i+1
296      y(i) =    11.2500;  t(i) =   4.0000; i=i+1
297      y(i) =     9.0000;  t(i) =   5.0000; i=i+1
298      y(i) =     6.6700;  t(i) =   6.0000; i=i+1
299      y(i) =    75.8000;  t(i) =    .5000; i=i+1
300      y(i) =    62.0000;  t(i) =    .7500; i=i+1
301      y(i) =    48.8000;  t(i) =   1.0000; i=i+1
302      y(i) =    35.2000;  t(i) =   1.5000; i=i+1
303      y(i) =    20.0000;  t(i) =   2.0000; i=i+1
304      y(i) =    20.3200;  t(i) =   2.0000; i=i+1
305      y(i) =    19.3100;  t(i) =   2.5000; i=i+1
306      y(i) =    12.7500;  t(i) =   3.0000; i=i+1
307      y(i) =    10.4200;  t(i) =   4.0000; i=i+1
308      y(i) =     7.3100;  t(i) =   5.0000; i=i+1
309      y(i) =     7.4200;  t(i) =   6.0000; i=i+1
310      y(i) =    70.5000;  t(i) =    .5000; i=i+1
311      y(i) =    59.5000;  t(i) =    .7500; i=i+1
312      y(i) =    48.5000;  t(i) =   1.0000; i=i+1
313      y(i) =    35.8000;  t(i) =   1.5000; i=i+1
314      y(i) =    21.0000;  t(i) =   2.0000; i=i+1
315      y(i) =    21.6700;  t(i) =   2.0000; i=i+1
316      y(i) =    21.0000;  t(i) =   2.5000; i=i+1
317      y(i) =    15.6400;  t(i) =   3.0000; i=i+1
318      y(i) =     8.1700;  t(i) =   4.0000; i=i+1
319      y(i) =     8.5500;  t(i) =   5.0000; i=i+1
320      y(i) =    10.1200;  t(i) =   6.0000; i=i+1
321      y(i) =    78.0000;  t(i) =    .5000; i=i+1
322      y(i) =    66.0000;  t(i) =    .6250; i=i+1
323      y(i) =    62.0000;  t(i) =    .7500; i=i+1
324      y(i) =    58.0000;  t(i) =    .8750; i=i+1
325      y(i) =    47.7000;  t(i) =   1.0000; i=i+1
326      y(i) =    37.8000;  t(i) =   1.2500; i=i+1
327      y(i) =    20.2000;  t(i) =   2.2500; i=i+1
328      y(i) =    21.0700;  t(i) =   2.2500; i=i+1
329      y(i) =    13.8700;  t(i) =   2.7500; i=i+1
330      y(i) =     9.6700;  t(i) =   3.2500; i=i+1
331      y(i) =     7.7600;  t(i) =   3.7500; i=i+1
332      y(i) =     5.4400;  t(i) =  4.2500; i=i+1
333      y(i) =     4.8700;  t(i) =  4.7500; i=i+1
334      y(i) =     4.0100;  t(i) =   5.2500; i=i+1
335      y(i) =     3.7500;  t(i) =   5.7500; i=i+1
336      y(i) =    24.1900;  t(i) =   3.0000; i=i+1
337      y(i) =    25.7600;  t(i) =   3.0000; i=i+1
338      y(i) =    18.0700;  t(i) =   3.0000; i=i+1
339      y(i) =    11.8100;  t(i) =   3.0000; i=i+1
340      y(i) =    12.0700;  t(i) =   3.0000; i=i+1
341      y(i) =    16.1200;  t(i) =   3.0000; i=i+1
342      y(i) =    70.8000;  t(i) =    .5000; i=i+1
343      y(i) =    54.7000;  t(i) =    .7500; i=i+1
344      y(i) =    48.0000;  t(i) =   1.0000; i=i+1
345      y(i) =    39.8000;  t(i) =   1.5000; i=i+1
346      y(i) =    29.8000;  t(i) =   2.0000; i=i+1
347      y(i) =    23.7000;  t(i) =   2.5000; i=i+1
348      y(i) =    29.6200;  t(i) =   2.0000; i=i+1
349      y(i) =    23.8100;  t(i) =   2.5000; i=i+1
350      y(i) =    17.7000;  t(i) =   3.0000; i=i+1
351      y(i) =    11.5500;  t(i) =   4.0000; i=i+1
352      y(i) =    12.0700;  t(i) =   5.0000; i=i+1
353      y(i) =     8.7400;  t(i) =   6.0000; i=i+1
354      y(i) =    80.7000;  t(i) =    .5000; i=i+1
355      y(i) =    61.3000;  t(i) =    .7500; i=i+1
356      y(i) =    47.5000;  t(i) =   1.0000; i=i+1
357      y(i) =    29.0000;  t(i) =   1.5000; i=i+1
358      y(i) =    24.0000;  t(i) =   2.0000; i=i+1
359      y(i) =    17.7000;  t(i) =   2.5000; i=i+1
360      y(i) =    24.5600;  t(i) =   2.0000; i=i+1
361      y(i) =    18.6700;  t(i) =   2.5000; i=i+1
362      y(i) =    16.2400;  t(i) =   3.0000; i=i+1
363      y(i) =     8.7400;  t(i) =   4.0000; i=i+1
364      y(i) =     7.8700;  t(i) =   5.0000; i=i+1
365      y(i) =     8.5100;  t(i) =   6.0000; i=i+1
366      y(i) =    66.7000;  t(i) =    .5000; i=i+1
367      y(i) =    59.2000;  t(i) =    .7500; i=i+1
368      y(i) =    40.8000;  t(i) =   1.0000; i=i+1
369      y(i) =    30.7000;  t(i) =   1.5000; i=i+1
370      y(i) =    25.7000;  t(i) =   2.0000; i=i+1
371      y(i) =    16.3000;  t(i) =   2.5000; i=i+1
372      y(i) =    25.9900;  t(i) =   2.0000; i=i+1
373      y(i) =    16.9500;  t(i) =   2.5000; i=i+1
374      y(i) =    13.3500;  t(i) =   3.0000; i=i+1
375      y(i) =     8.6200;  t(i) =   4.0000; i=i+1
376      y(i) =     7.2000;  t(i) =   5.0000; i=i+1
377      y(i) =     6.6400;  t(i) =   6.0000; i=i+1
378      y(i) =    13.6900;  t(i) =   3.0000; i=i+1
379      y(i) =    81.0000;  t(i) =    .5000; i=i+1
380      y(i) =    64.5000;  t(i) =    .7500; i=i+1
381      y(i) =    35.5000;  t(i) =   1.5000; i=i+1
382      y(i) =    13.3100;  t(i) =   3.0000; i=i+1
383      y(i) =     4.8700;  t(i) =   6.0000; i=i+1
384      y(i) =    12.9400;  t(i) =   3.0000; i=i+1
385      y(i) =     5.0600;  t(i) =   6.0000; i=i+1
386      y(i) =    15.1900;  t(i) =   3.0000; i=i+1
387      y(i) =    14.6200;  t(i) =   3.0000; i=i+1
388      y(i) =    15.6400;  t(i) =   3.0000; i=i+1
389      y(i) =    25.5000;  t(i) =   1.7500; i=i+1
390      y(i) =    25.9500;  t(i) =   1.7500; i=i+1
391      y(i) =    81.7000;  t(i) =    .5000; i=i+1
392      y(i) =    61.6000;  t(i) =    .7500; i=i+1
393      y(i) =    29.8000;  t(i) =   1.7500; i=i+1
394      y(i) =    29.8100;  t(i) =   1.7500; i=i+1
395      y(i) =    17.1700;  t(i) =   2.7500; i=i+1
396      y(i) =    10.3900;  t(i) =   3.7500; i=i+1
397      y(i) =    28.4000;  t(i) =   1.7500; i=i+1
398      y(i) =    28.6900;  t(i) =   1.7500; i=i+1
399      y(i) =    81.3000;  t(i) =    .5000; i=i+1
400      y(i) =    60.9000;  t(i) =    .7500; i=i+1
401      y(i) =    16.6500;  t(i) =   2.7500; i=i+1
402      y(i) =    10.0500;  t(i) =   3.7500; i=i+1
403      y(i) =    28.9000;  t(i) =   1.7500; i=i+1
404      y(i) =    28.9500;  t(i) =   1.7500; i=i+1
405
406      return
407      end
408
409      subroutine TaskWorker(ierr)
410      use chwirut2fmodule
411
412      PetscErrorCode ierr
413      PetscReal x(n),f(1)
414      PetscMPIInt tag
415      PetscInt index
416      PetscMPIInt status(MPI_STATUS_SIZE)
417
418      tag = IDLE_TAG
419      f   = 0.0
420      ! Send check-in message to rank-0
421      PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,IDLE_TAG,PETSC_COMM_WORLD,ierr))
422      do while (tag .ne. DIE_TAG)
423         PetscCallMPI(MPI_Recv(x,nn,MPIU_SCALAR,zero,MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr))
424         tag = status(MPI_TAG)
425         if (tag .eq. IDLE_TAG) then
426            PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,IDLE_TAG,PETSC_COMM_WORLD,ierr))
427         else if (tag .ne. DIE_TAG) then
428            index = tag
429            ! Compute local part of residual
430            PetscCall(RunSimulation(x,index,f(1),ierr))
431
432            ! Return residual to rank-0
433            PetscCallMPI(MPI_Send(f,one,MPIU_SCALAR,zero,tag,PETSC_COMM_WORLD,ierr))
434         end if
435      enddo
436      ierr = 0
437      return
438      end
439
440      subroutine RunSimulation(x,i,f,ierr)
441      use chwirut2fmodule
442
443      PetscReal x(n),f
444      PetscInt i
445      PetscErrorCode ierr
446      f = y(i) - exp(-x(1)*t(i))/(x(2)+x(3)*t(i))
447      ierr = 0
448      return
449      end
450
451      subroutine StopWorkers(ierr)
452      use chwirut2fmodule
453
454      integer checkedin
455      PetscMPIInt status(MPI_STATUS_SIZE)
456      PetscMPIInt source
457      PetscReal f(1),x(n)
458      PetscErrorCode ierr
459      PetscInt i
460
461      checkedin=0
462      do while (checkedin .lt. size-1)
463         PetscCallMPI(MPI_Recv(f,one,MPIU_SCALAR,MPI_ANY_SOURCE,MPI_ANY_TAG,PETSC_COMM_WORLD,status,ierr))
464         checkedin=checkedin+1
465         source = status(MPI_SOURCE)
466         do i=1,n
467           x(i) = 0.0
468         enddo
469         PetscCallMPI(MPI_Send(x,nn,MPIU_SCALAR,source,DIE_TAG,PETSC_COMM_WORLD,ierr))
470      enddo
471      ierr = 0
472      return
473      end
474
475!/*TEST
476!
477!   build:
478!      requires: !complex
479!
480!   test:
481!      nsize: 3
482!      args: -tao_monitor_short -tao_max_it 100 -tao_type pounders -tao_gatol 1.e-5
483!      requires: !single
484!
485!
486!TEST*/
487