xref: /petsc/src/sys/tutorials/ex5f90.F90 (revision e41f517f4d18e1c8d622486babf146494d335f64)
1#include <petsc/finclude/petscsys.h>
2#include <petsc/finclude/petscbag.h>
3#include <petsc/finclude/petscviewer.h>
4
5      module 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
26      end module ex5f90module
27
28      module 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
39      end module ex5f90Bag_interface_module
40
41      program 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))
118      end program ex5f90
119
120!
121!/*TEST
122!
123!   build:
124!      requires: defined(PETSC_USING_F2003) defined(PETSC_USING_F90FREEFORM)
125!
126!   test:
127!      args: -pbag_rarray 4,5,88
128!
129!TEST*/
130