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