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