xref: /petsc/src/sys/tutorials/ex5f90.F90 (revision f84028053d197aff3fdf060e86d88b3f1b0f0110)
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
6c4762a1bSJed Brown      module Bag_data_module
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
25c4762a1bSJed Brown      end module Bag_data_module
26c4762a1bSJed Brown
27c4762a1bSJed Brown      module Bag_interface_module
28c4762a1bSJed Brown      use Bag_data_module
29c4762a1bSJed Brown
30c4762a1bSJed Brown      interface PetscBagGetData
31c4762a1bSJed Brown         subroutine PetscBagGetData(bag,data,ierr)
32c4762a1bSJed Brown           use Bag_data_module
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
38c4762a1bSJed Brown      end module Bag_interface_module
39c4762a1bSJed Brown
40c4762a1bSJed Brown      program ex5f90
41c4762a1bSJed Brown      use Bag_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
57*f8402805SBarry Smith      PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER,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
72*f8402805SBarry Smith      PetscCallA(PetscBagCreate(PETSC_COMM_WORLD,sizeofbag,bag,ierr))
73*f8402805SBarry Smith      PetscCallA(PetscBagGetData(bag,data,ierr))
74*f8402805SBarry Smith      PetscCallA(PetscBagSetName(bag,'demo parameters','super secret demo parameters in a bag',ierr))
75*f8402805SBarry Smith      PetscCallA(PetscBagSetOptionsPrefix(bag, 'pbag_', ierr))
76c4762a1bSJed Brown
77c4762a1bSJed Brown! register the data within the bag, grabbing values from the options database
78c4762a1bSJed Brown!     Need to put the value into a variable for 64 bit indices
79c4762a1bSJed Brown      int56 = 56
80*f8402805SBarry Smith      PetscCallA(PetscBagRegisterInt(bag,data%nxc ,int56,'nxc','nxc_variable help message',ierr))
81*f8402805SBarry 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
84*f8402805SBarry Smith      PetscCallA(PetscBagRegisterScalar(bag,data%x ,svalue,'x','x variable help message',ierr))
85*f8402805SBarry Smith      PetscCallA(PetscBagRegisterBool(bag,data%t ,PETSC_TRUE,'t','t boolean help message',ierr))
86*f8402805SBarry Smith      PetscCallA(PetscBagRegisterBoolArray(bag,data%tarray,three,'tarray','tarray help message',ierr))
87*f8402805SBarry Smith      PetscCallA(PetscBagRegisterString(bag,data%c,'hello','c','string help message',ierr))
88c4762a1bSJed Brown      value = -11.00
89*f8402805SBarry Smith      PetscCallA(PetscBagRegisterReal(bag,data%y ,value,'y','y variable help message',ierr))
90c4762a1bSJed Brown      value = 1.00
91*f8402805SBarry Smith      PetscCallA(PetscBagRegisterReal(bag,data%pos%x1 ,value,'pos_x1','tuple value 1 help message',ierr))
92c4762a1bSJed Brown      value = 2.00
93*f8402805SBarry Smith      PetscCallA(PetscBagRegisterReal(bag,data%pos%x2 ,value,'pos_x2','tuple value 2 help message',ierr))
94*f8402805SBarry Smith      PetscCallA(PetscBagRegisterEnum(bag,data%enum ,list,1,'enum','tuple value 2 help message',ierr))
95*f8402805SBarry 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/)
105*f8402805SBarry Smith      PetscCallA(PetscBagView(bag,PETSC_VIEWER_BINARY_WORLD,ierr))
106c4762a1bSJed Brown
107*f8402805SBarry Smith      PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',FILE_MODE_READ,viewer,ierr))
108*f8402805SBarry Smith      PetscCallA(PetscBagLoad(viewer,bag,ierr))
109*f8402805SBarry Smith      PetscCallA(PetscViewerDestroy(viewer,ierr))
110*f8402805SBarry Smith      PetscCallA(PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr))
111c4762a1bSJed Brown
112*f8402805SBarry Smith      PetscCallA(PetscBagSetFromOptions(bag,ierr))
113*f8402805SBarry Smith      PetscCallA(PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr))
114*f8402805SBarry Smith      PetscCallA(PetscBagDestroy(bag,ierr))
115c4762a1bSJed Brown
116*f8402805SBarry 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