download the original source code.
1 c
2 c Example 6
3 c
4 c Interface: Semi-Structured interface (SStruct). Fortran - Babel version.
5 c
6 c Compile with: make ex6
7 c
8 c Sample run: mpirun -np 2 ex6
9 c
10 c Description: This is a two processor example and is the same problem
11 c as is solved with the structured interface in Example 2.
12 c (The grid boxes are exactly those in the example
13 c diagram in the struct interface chapter of the User's Manual.
14 c Processor 0 owns two boxes and processor 1 owns one box.)
15 c
16 c This is the simplest sstruct example, and it demonstrates how
17 c the semi-structured interface can be used for structured problems.
18 c There is one part and one variable. The solver is PCG with SMG
19 c preconditioner. We use a structured solver for this example.
20
21
22 program ex6b77
23
24 implicit none
25
26 include 'mpif.h'
27
28 include "HYPREf.h"
29 c ...If HYPREf.h doesn't exist in your version of HYPRE, just use
30 c these two lines from it:
31 c integer HYPRE_STRUCT
32 c parameter( HYPRE_STRUCT = 1111 )
33
34 include 'bHYPRE_SStructVariable.inc'
35 c ... This file is generated into babel/bHYPREClient-F. A future version
36 c of the makefiles will copy it to hypre/include.
37
38 integer MAX_LOCAL_SIZE
39 parameter (MAX_LOCAL_SIZE=123000)
40 integer MAXBLKS
41 parameter (MAXBLKS=32)
42 integer MAX_STENCIL_SIZE
43 parameter (MAX_STENCIL_SIZE=27)
44 integer MAXDIM
45 parameter (MAXDIM=3)
46
47 integer myid, num_procs
48
49 integer*8 grid
50 integer*8 graph
51 integer*8 stencil
52 integer*8 A
53 integer*8 b
54 integer*8 x
55 integer*8 bHYPRE_mpicomm
56 integer*8 except
57 integer*8 mpi_comm
58 integer*8 sA
59 integer*8 vb
60 integer*8 vx
61 integer*8 dummy
62 integer*8 opA
63
64
65 c We are using struct solvers for this example
66 integer*8 PCGsolver
67 integer*8 SMGprecond
68 integer*8 precond
69
70 integer object_type, ndim, ierr, ierrtmp
71 integer ilower(MAXDIM)
72 integer iupper(MAXDIM)
73 integer i, j, nparts, part, nvars, var
74 integer vartypes(1)
75 integer entry, nentries, nvalues, maxnvalues
76 double precision tol
77 double precision values(MAX_STENCIL_SIZE*MAX_LOCAL_SIZE)
78 integer stencil_indices(MAX_STENCIL_SIZE)
79 integer offsets(2,5)
80
81 ndim = 2
82 ierr = 0
83 ierrtmp = 0
84
85 c Initialize MPI
86 call MPI_INIT(ierr)
87 call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr)
88 call MPI_COMM_SIZE(MPI_COMM_WORLD, num_procs, ierr)
89 mpi_comm = MPI_COMM_WORLD
90 call bHYPRE_MPICommunicator_CreateF_f( mpi_comm, bHYPRE_mpicomm,
91 1 except )
92
93 if ( num_procs .ne. 2 ) then
94 print *, 'Must run with 2 processors!'
95 call MPI_Finalize(ierrtmp)
96 stop
97 endif
98
99
100
101 c 1. Set up the 2D grid. This gives the index space in each part.
102 c Here we only use one part and one variable. (So the part id is 0
103 c and the variable id is 0)
104
105 nparts = 1
106 part = 0
107
108 c Create an empty 2D grid object
109 call bHYPRE_SStructGrid_Create_f( bHYPRE_mpicomm, ndim, nparts,
110 1 grid, except );
111
112 c Set the extents of the grid - each processor sets its grid
113 c boxes. Each part has its own relative index space numbering,
114 c but in this example all boxes belong to the same part.
115
116 c Processor 0 owns two boxes in the grid.
117 if ( myid .eq. 0 ) then
118 c Add a new box to the grid
119 ilower(1) = -3
120 ilower(2) = 1
121 iupper(1) = -1
122 iupper(2) = 2
123 call bHYPRE_SStructGrid_SetExtents_f( grid, part,
124 1 ilower, iupper, ndim, ierr, except )
125
126 c Add a new box to the grid */
127 ilower(1) = 0
128 ilower(2) = 1
129 iupper(1) = 2
130 iupper(2) = 4
131 call bHYPRE_SStructGrid_SetExtents_f( grid, part,
132 1 ilower, iupper, ndim, ierr, except )
133
134 c Processor 1 owns one box in the grid.
135 elseif ( myid .eq. 1 ) then
136 c Add a new box to the grid */
137 ilower(1) = 3
138 ilower(2) = 1
139 iupper(1) = 6
140 iupper(2) = 4
141 call bHYPRE_SStructGrid_SetExtents_f( grid, part,
142 1 ilower, iupper, ndim, ierr, except )
143 endif
144
145 c Set the variable type and number of variables on each part.
146 nvars = 1
147 var = 0
148 vartypes(1) = CELL
149
150 do i = 0, nparts-1
151 call bHYPRE_SStructGrid_SetVariable_f( grid, i, var, nvars,
152 1 vartypes(1), ierr, except )
153 enddo
154 c ... if nvars>1 we would need a number of AddVariable calls
155
156 c Now the grid is ready to use
157 call bHYPRE_SStructGrid_Assemble_f( grid, ierr, except )
158
159 c 2. Define the discretization stencil(s)
160 c Create an empty 2D, 5-pt stencil object */
161 call bHYPRE_SStructStencil_Create_f( 2, 5, stencil, except )
162
163 c Define the geometry of the stencil. Each represents a
164 c relative offset (in the index space).
165 offsets(1,1) = 0
166 offsets(2,1) = 0
167 offsets(1,2) = -1
168 offsets(2,2) = 0
169 offsets(1,3) = 1
170 offsets(2,3) = 0
171 offsets(1,4) = 0
172 offsets(2,4) = -1
173 offsets(1,5) = 0
174 offsets(2,5) = 1
175 var = 0
176
177 c Assign numerical values to the offsets so that we can
178 c easily refer to them - the last argument indicates the
179 c variable for which we are assigning this stencil - we are
180 c just using one variable in this example so it is the first one (0)
181 do entry = 1, 5
182 call bHYPRE_SStructStencil_SetEntry_f( stencil, entry-1,
183 1 offsets(1,entry), ndim, var, ierr, except )
184 enddo
185
186 c 3. Set up the Graph - this determines the non-zero structure
187 c of the matrix and allows non-stencil relationships between the parts
188 var = 0
189 part = 0
190
191 c Create the graph object
192 call bHYPRE_SStructGraph_Create_f( bHYPRE_mpicomm, grid, graph,
193 1 except )
194
195 c Now we need to tell the graph which stencil to use for each
196 c variable on each part (we only have one variable and one part)
197 call bHYPRE_SStructGraph_SetStencil_f( graph, part, var, stencil,
198 1 ierr, except )
199
200 c Here we could establish connections between parts if we
201 c had more than one part using the graph. For example, we could
202 c use HYPRE_GraphAddEntries() routine or HYPRE_GridSetNeighborBox()
203
204 c Assemble the graph
205 call bHYPRE_SStructGraph_Assemble_f( graph, ierr, except )
206
207 c 4. Set up a SStruct Matrix
208 part = 0
209 var = 0
210
211 c Create the empty matrix object
212 call bHYPRE_SStructMatrix_Create_f( bHYPRE_mpicomm, graph, A,
213 1 except )
214
215 c Set the object type (by default HYPRE_SSTRUCT). This determines the
216 c data structure used to store the matrix. If you want to use unstructured
217 c solvers, e.g. BoomerAMG, the object type should be HYPRE_PARCSR.
218 c If the problem is purely structured (with one part), you may want to use
219 c HYPRE_STRUCT to access the structured solvers. Here we have a purely
220 c structured example.
221 object_type = HYPRE_STRUCT
222 call bHYPRE_SStructMatrix_SetObjectType_f( A, object_type,
223 1 ierr, except )
224
225 c Get ready to set values
226 call bHYPRE_SStructMatrix_Initialize_f( A, ierr, except )
227
228 c Each processor must set the stencil values for their boxes on each part.
229 c In this example, we only set stencil entries and therefore use
230 c HYPRE_SStructMatrixSetBoxValues. If we need to set non-stencil entries,
231 c we have to use HYPRE_SStructMatrixSetValues (shown in a later example).
232
233 if ( myid .eq. 0 ) then
234 c Set the matrix coefficients for some set of stencil entries
235 c over all the gridpoints in my first box (account for boundary
236 c grid points later)
237 ilower(1) = -3
238 ilower(2) = 1
239 iupper(1) = -1
240 iupper(2) = 2
241 nentries = 5
242 nvalues = 30
243 c ... nvalues=30 from 6 grid points, each with 5 stencil entries
244
245 do j = 1, nentries
246 c label the stencil indices - these correspond to the offsets
247 c defined above ...
248 stencil_indices(j) = j-1
249 enddo
250
251 do i = 1, nvalues, nentries
252 values(i) = 4.0
253 do j = 1, nentries-1
254 values(i+j) = -1.0
255 enddo
256 enddo
257
258 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
259 1 ilower, iupper, ndim, var, nentries, stencil_indices,
260 2 values, nvalues, ierr, except )
261
262 c Set the matrix coefficients for some set of stencil entries
263 c over the gridpoints in my second box
264 ilower(1) = 0
265 ilower(2) = 1
266 iupper(1) = 2
267 iupper(2) = 4
268 nentries = 5
269 nvalues = 60
270 c ... nvalues=60 from 12 grid points, each with 5 stencil entries
271
272 do j = 1, nentries
273 stencil_indices(j) = j-1
274 enddo
275
276 do i = 1, nvalues, nentries
277 values(i) = 4.0
278 do j = 1, nentries-1
279 values(i+j) = -1.0;
280 enddo
281 enddo
282
283 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
284 1 ilower, iupper, ndim, var, nentries, stencil_indices,
285 2 values, nvalues, ierr, except )
286
287 elseif ( myid .eq. 1 ) then
288 c Set the matrix coefficients for some set of stencil entries
289 c over the gridpoints in my box
290 ilower(1) = 3
291 ilower(2) = 1
292 iupper(1) = 6
293 iupper(2) = 4
294 nentries = 5
295 nvalues = 80
296 c ... nentries=80 from 16 grid points, each with 5 stencil entries
297
298 do j = 1, nentries
299 stencil_indices(j) = j-1
300 enddo
301
302 do i = 1, nvalues, nentries
303 values(i) = 4.0
304 do j = 1, nentries-1
305 values(i+j) = -1.0
306 enddo
307 enddo
308
309 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
310 1 ilower, iupper, ndim, var, nentries, stencil_indices,
311 2 values, nvalues, ierr, except )
312
313 endif
314
315 c For each box, set any coefficients that reach ouside of the
316 c boundary to 0
317 if ( myid .eq. 0 )then
318 maxnvalues = 6;
319
320 do i = 1, maxnvalues
321 values(i) = 0.0
322 enddo
323
324 c Values below our first AND second box
325 ilower(1) = -3
326 ilower(2) = 1
327 iupper(1) = 2
328 iupper(2) = 1
329 nvalues = 6
330 stencil_indices(1) = 3
331
332 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
333 1 ilower, iupper, ndim, var, 1, stencil_indices,
334 2 values, nvalues, ierr, except )
335
336 c Values to the left of our first box
337 ilower(1) = -3
338 ilower(2) = 1
339 iupper(1) = -3
340 iupper(2) = 2
341 nvalues = 2
342 stencil_indices(1) = 1
343
344 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
345 1 ilower, iupper, ndim, var, 1, stencil_indices,
346 2 values, nvalues, ierr, except )
347
348 c Values above our first box
349 ilower(1) = -3
350 ilower(2) = 2
351 iupper(1) = -1
352 iupper(2) = 2
353 nvalues = 3
354 stencil_indices(1) = 4
355
356 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
357 1 ilower, iupper, ndim, var, 1, stencil_indices,
358 2 values, nvalues, ierr, except )
359
360 c Values to the left of our second box (that do not border the
361 c first box).
362 ilower(1) = 0
363 ilower(2) = 3
364 iupper(1) = 0
365 iupper(2) = 4
366 nvalues = 2
367 stencil_indices(1) = 1
368
369 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
370 1 ilower, iupper, ndim, var, 1, stencil_indices,
371 2 values, nvalues, ierr, except )
372
373 c Values above our second box
374 ilower(1) = 0
375 ilower(2) = 4
376 iupper(1) = 2
377 iupper(2) = 4
378 nvalues = 3
379 stencil_indices(1) = 4
380
381 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
382 1 ilower, iupper, ndim, var, 1, stencil_indices,
383 2 values, nvalues, ierr, except )
384
385 elseif ( myid .eq. 1 ) then
386 maxnvalues = 4;
387
388 do i = 1, maxnvalues
389 values(i) = 0.0
390 enddo
391
392 c Values below our box
393 ilower(1) = 3
394 ilower(2) = 1
395 iupper(1) = 6
396 iupper(2) = 1
397 nvalues = 4
398 stencil_indices(1) = 3
399
400 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
401 1 ilower, iupper, ndim, var, 1, stencil_indices,
402 2 values, nvalues, ierr, except )
403
404 c Values to the right of our box
405 ilower(1) = 6
406 ilower(2) = 1
407 iupper(1) = 6
408 iupper(2) = 4
409 nvalues = 4
410 stencil_indices(1) = 2
411
412 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
413 1 ilower, iupper, ndim, var, 1, stencil_indices,
414 2 values, nvalues, ierr, except )
415
416 c Values above our box
417 ilower(1) = 3
418 ilower(2) = 4
419 iupper(1) = 6
420 iupper(2) = 4
421 nvalues = 4
422 stencil_indices(1) = 4
423
424 call bHYPRE_SStructMatrix_SetBoxValues_f( A, part,
425 1 ilower, iupper, ndim, var, 1, stencil_indices,
426 2 values, nvalues, ierr, except )
427
428 endif
429
430 c This is a collective call finalizing the matrix assembly.
431 c The matrix is now ``ready to be used''
432 call bHYPRE_SStructMatrix_Assemble_f( A, ierr, except )
433
434
435
436 c 5. Set up SStruct Vectors for b and x
437
438 c We have one part and one variable.
439 part = 0
440 var = 0
441
442 c Create an empty vector object
443 call bHYPRE_SStructVector_Create_f( bHYPRE_mpicomm, grid, b,
444 1 except )
445 call bHYPRE_SStructVector_Create_f( bHYPRE_mpicomm, grid, x,
446 1 except )
447
448 c As with the matrix, set the object type for the vectors
449 c to be the struct type
450 object_type = HYPRE_STRUCT;
451 call bHYPRE_SStructVector_SetObjectType_f( b, object_type,
452 1 ierr, except)
453 call bHYPRE_SStructVector_SetObjectType_f( x, object_type,
454 1 ierr, except)
455
456 c Indicate that the vector coefficients are ready to be set
457 call bHYPRE_SStructVector_Initialize_f( b, ierr, except )
458 call bHYPRE_SStructVector_Initialize_f( x, ierr, except )
459
460 if ( myid .eq. 0 ) then
461 c Set the vector coefficients over the gridpoints in my first box
462 ilower(1) = -3
463 ilower(2) = 1
464 iupper(1) = -1
465 iupper(2) = 2
466 nvalues = 6
467 c ... 6 grid points
468
469 do i = 1, nvalues
470 values(i) = 1.0
471 enddo
472 call bHYPRE_SStructVector_SetBoxValues_f( b, part,
473 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
474
475 do i = 1, nvalues
476 values(i) = 0.0
477 enddo
478 call bHYPRE_SStructVector_SetBoxValues_f( x, part,
479 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
480
481 c Set the vector coefficients over the gridpoints in my second box
482 ilower(1) = 0
483 ilower(2) = 1
484 iupper(1) = 2
485 iupper(2) = 4
486 nvalues = 12
487 c ... 12 grid points
488
489 do i = 1, nvalues
490 values(i) = 1.0
491 enddo
492 call bHYPRE_SStructVector_SetBoxValues_f( b, part,
493 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
494
495 do i = 1, nvalues
496 values(i) = 0.0
497 enddo
498 call bHYPRE_SStructVector_SetBoxValues_f( x, part,
499 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
500
501 elseif ( myid .eq. 1 ) then
502 c Set the vector coefficients over the gridpoints in my box
503 ilower(1) = 3
504 ilower(2) = 1
505 iupper(1) = 6
506 iupper(2) = 4
507 nvalues = 16
508 c ... 16 grid points
509
510 do i = 1, nvalues
511 values(i) = 1.0
512 enddo
513 call bHYPRE_SStructVector_SetBoxValues_f( b, part,
514 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
515
516 do i = 1, nvalues
517 values(i) = 0.0
518 enddo
519 call bHYPRE_SStructVector_SetBoxValues_f( x, part,
520 1 ilower, iupper, ndim, var, values, nvalues, ierr, except )
521
522 endif
523
524 c This is a collective call finalizing the vector assembly.
525 c The vectors are now ``ready to be used''
526 call bHYPRE_SStructVector_Assemble_f( b, ierr, except )
527 call bHYPRE_SStructVector_Assemble_f( x, ierr, except )
528
529
530
531 c 6. Set up and use a solver (See the Reference Manual for descriptions
532 c of all of the options.)
533
534 c Because we are using a struct solver, we need to get the
535 c object of the matrix and vectors to pass in to the struct solvers
536 call bHYPRE_SStructMatrix_GetObject_f( A, dummy, ierr, except )
537 call bHYPRE_StructMatrix__cast_f( dummy, sA,except )
538 call sidl_BaseInterface_deleteRef_f( dummy, except )
539 call bHYPRE_SStructVector_GetObject_f( b, dummy, ierr, except )
540 call bHYPRE_Vector__cast_f( dummy, vb, except )
541 call sidl_BaseInterface_deleteRef_f( dummy, except )
542 call bHYPRE_SStructVector_GetObject_f( x, dummy, ierr, except )
543 call bHYPRE_Vector__cast_f( dummy, vx, except )
544 call sidl_BaseInterface_deleteRef_f( dummy, except )
545
546 c Create an empty PCG Struct solver
547 call bHYPRE_Operator__cast_f( sA, opA, except )
548 call bHYPRE_PCG_Create_f( bHYPRE_mpicomm, opA, PCGsolver,
549 1 except )
550
551 c Set PCG parameters
552 c Note that tol must be passed as a variable - putting 1.0e-6 directly
553 c in the argument list won't work.
554 tol = 1.0e-6
555 call bHYPRE_PCG_SetDoubleParameter_f( PCGsolver, "Tolerance",
556 1 tol, ierr, except )
557 call bHYPRE_PCG_SetIntParameter_f( PCGsolver, "PrintLevel",
558 1 2, ierr, except )
559 call bHYPRE_PCG_SetIntParameter_f( PCGsolver, "MaxIter",
560 1 50, ierr, except )
561
562 c Create the Struct SMG solver for use as a preconditioner
563 call bHYPRE_StructSMG_Create_f( bHYPRE_mpicomm, sA, SMGprecond,
564 1 except )
565
566 c Set SMG parameters
567 call bHYPRE_StructSMG_SetIntParameter_f( SMGprecond,
568 1 "MaxIter", 1, ierr, except )
569 tol = 0.0
570 call bHYPRE_StructSMG_SetDoubleParameter_f( SMGprecond,
571 1 "Tolerance", tol, ierr, except )
572 call bHYPRE_StructSMG_SetIntParameter_f( SMGprecond,
573 1 "ZeroGuess", 1, ierr, except )
574 call bHYPRE_StructSMG_SetIntParameter_f( SMGprecond,
575 1 "NumPreRelax", 1, ierr, except )
576 call bHYPRE_StructSMG_SetIntParameter_f( SMGprecond,
577 1 "NumPostRelax", 1, ierr, except )
578
579 c Set preconditioner and solve
580 call bHYPRE_Solver__cast_f( SMGprecond, precond, except )
581 call bHYPRE_PCG_SetPreconditioner_f( PCGsolver, precond,
582 1 ierr, except )
583
584 call bHYPRE_PCG_Setup_f( PCGsolver, vb, vx, ierr, except )
585 call bHYPRE_PCG_Apply_f( PCGsolver, vb, vx, ierr, except )
586
587 call bHYPRE_Operator_deleteRef_f( opA, except )
588 call bHYPRE_Vector_deleteRef_f( vx, except )
589 call bHYPRE_Vector_deleteRef_f( vb, except )
590 call bHYPRE_StructMatrix_deleteRef_f( sA, except )
591
592
593 c Free memory
594 call bHYPRE_Solver_deleteRef_f( precond, except )
595 call bHYPRE_StructSMG_deleteRef_f( SMGprecond, except )
596 call bHYPRE_PCG_deleteRef_f( PCGsolver, except )
597 call bHYPRE_SStructVector_deleteRef_f( x, except )
598 call bHYPRE_SStructVector_deleteRef_f( b, except )
599 call bHYPRE_SStructMatrix_deleteRef_f( A, except )
600 call bHYPRE_SStructGraph_deleteRef_f( graph, except )
601 call bHYPRE_SStructStencil_deleteRef_f( stencil, except )
602 call bHYPRE_SStructGrid_deleteRef_f( grid, except )
603 call bHYPRE_MPICommunicator_deleteRef_f( bHYPRE_mpicomm, except )
604
605 c Finalize MPI
606 call MPI_Finalize(ierrtmp)
607
608 return
609 end
syntax highlighted by Code2HTML, v. 0.9.1