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