xref: /petsc/src/sys/tutorials/ex5f90.F90 (revision ccfb0f9f40a0131988d7995ed9679700dae2a75a)
1#include <petsc/finclude/petscsys.h>
2#include <petsc/finclude/petscbag.h>
3#include <petsc/finclude/petscviewer.h>
4
5module ex5f90module
6  use petscsys
7  use petscbag
8!     Data structure used to contain information about the problem
9!     You can add physical values etc here
10
11  type tuple
12    PetscReal:: x1, x2
13  end type tuple
14
15  type bag_data_type
16    PetscScalar :: x
17    PetscReal :: y
18    PetscInt  :: nxc
19    PetscReal :: rarray(3)
20    PetscBool  :: t
21    PetscBool  :: tarray(3)
22    PetscEnum :: enum
23    character*(80) :: c
24    type(tuple) :: pos
25  end type bag_data_type
26end module ex5f90module
27
28module ex5f90Bag_interface_module
29  use ex5f90module
30
31  interface PetscBagGetData
32    subroutine PetscBagGetData(bag, data, ierr)
33      use ex5f90module
34      PetscBag bag
35      type(bag_data_type), pointer :: data
36      PetscErrorCode ierr
37    end subroutine PetscBagGetData
38  end interface
39end module ex5f90Bag_interface_module
40
41program ex5f90
42  use ex5f90Bag_interface_module
43  use petsc
44  implicit none
45
46  PetscBag bag
47  PetscErrorCode ierr
48  type(bag_data_type), pointer :: data
49  type(bag_data_type)          :: dummydata
50  character(len=1), pointer     :: dummychar(:)
51  PetscViewer viewer
52  PetscSizeT sizeofbag
53  Character(len=99) list(6)
54  PetscInt three, int56
55  PetscReal value
56  PetscScalar svalue
57
58  PetscCallA(PetscInitialize(ierr))
59  list(1) = 'a123'
60  list(2) = 'b456'
61  list(3) = 'c789'
62  list(4) = 'list'
63  list(5) = 'prefix_'
64  list(6) = ''
65!     cannot just pass a 3 to PetscBagRegisterXXXArray() because it is expecting a PetscInt
66  three = 3
67
68!   compute size of the data
69!
70  sizeofbag = size(transfer(dummydata, dummychar))
71
72! create the bag
73  PetscCallA(PetscBagCreate(PETSC_COMM_WORLD, sizeofbag, bag, ierr))
74  PetscCallA(PetscBagGetData(bag, data, ierr))
75  PetscCallA(PetscBagSetName(bag, 'demo parameters', 'super secret demo parameters in a bag', ierr))
76  PetscCallA(PetscBagSetOptionsPrefix(bag, 'pbag_', ierr))
77
78! register the data within the bag, grabbing values from the options database
79!     Need to put the value into a variable for 64-bit indices
80  int56 = 56
81  PetscCallA(PetscBagRegisterInt(bag, data%nxc, int56, 'nxc', 'nxc_variable help message', ierr))
82  PetscCallA(PetscBagRegisterRealArray(bag, data%rarray, three, 'rarray', 'rarray help message', ierr))
83!     Need to put the value into a variable to pass correctly for 128 bit quad precision numbers
84  svalue = 103.20
85  PetscCallA(PetscBagRegisterScalar(bag, data%x, svalue, 'x', 'x variable help message', ierr))
86  PetscCallA(PetscBagRegisterBool(bag, data%t, PETSC_TRUE, 't', 't boolean help message', ierr))
87  PetscCallA(PetscBagRegisterBoolArray(bag, data%tarray, three, 'tarray', 'tarray help message', ierr))
88  PetscCallA(PetscBagRegisterString(bag, data%c, 'hello', 'c', 'string help message', ierr))
89  value = -11.00
90  PetscCallA(PetscBagRegisterReal(bag, data%y, value, 'y', 'y variable help message', ierr))
91  value = 1.00
92  PetscCallA(PetscBagRegisterReal(bag, data%pos%x1, value, 'pos_x1', 'tuple value 1 help message', ierr))
93  value = 2.00
94  PetscCallA(PetscBagRegisterReal(bag, data%pos%x2, value, 'pos_x2', 'tuple value 2 help message', ierr))
95  PetscCallA(PetscBagRegisterEnum(bag, data%enum, list, 1, 'enum', 'tuple value 2 help message', ierr))
96  PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
97
98  data%nxc = 23
99  data%rarray(1) = -1.0
100  data%rarray(2) = -2.0
101  data%rarray(3) = -3.0
102  data%x = 155.4
103  data%c = 'a whole new string'
104  data%t = PETSC_TRUE
105  data%tarray = (/PETSC_TRUE, PETSC_FALSE, PETSC_TRUE/)
106  PetscCallA(PetscBagView(bag, PETSC_VIEWER_BINARY_WORLD, ierr))
107
108  PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD, 'binaryoutput', FILE_MODE_READ, viewer, ierr))
109  PetscCallA(PetscBagLoad(viewer, bag, ierr))
110  PetscCallA(PetscViewerDestroy(viewer, ierr))
111  PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
112
113  PetscCallA(PetscBagSetFromOptions(bag, ierr))
114  PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
115  PetscCallA(PetscBagDestroy(bag, ierr))
116
117  PetscCallA(PetscFinalize(ierr))
118end program ex5f90
119
120!
121!/*TEST
122!
123!   test:
124!      args: -pbag_rarray 4,5,88
125!
126!TEST*/
127