Actual source code: chwirut2f.F

tao-2.1-p0 2012-07-24
  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: