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