xref: /petsc/src/sys/tutorials/ex5f90.F90 (revision dfd57a172ac9fa6c7b5fe6de6ab5df85cefc2996)
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
57c4762a1bSJed Brown      Call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
58c4762a1bSJed Brown      if (ierr .ne. 0) then
59c4762a1bSJed Brown         print*,'Unable to initialize PETSc'
60c4762a1bSJed Brown         stop
61c4762a1bSJed Brown      endif
62c4762a1bSJed Brown      list(1) = 'a123'
63c4762a1bSJed Brown      list(2) = 'b456'
64c4762a1bSJed Brown      list(3) = 'c789'
65c4762a1bSJed Brown      list(4) = 'list'
66c4762a1bSJed Brown      list(5) = 'prefix_'
67c4762a1bSJed Brown      list(6) = ''
68c4762a1bSJed Brown!     cannot just pass a 3 to PetscBagRegisterXXXArray() because it is expecting a PetscInt
69c4762a1bSJed Brown      three   = 3
70c4762a1bSJed Brown
71c4762a1bSJed Brown!   compute size of the data
72c4762a1bSJed Brown!
73c4762a1bSJed Brown      sizeofbag = size(transfer(dummydata,dummychar))
74c4762a1bSJed Brown
75c4762a1bSJed Brown! create the bag
76c4762a1bSJed Brown      call PetscBagCreate(PETSC_COMM_WORLD,sizeofbag,bag,ierr);CHKERRA(ierr)
77c4762a1bSJed Brown      call PetscBagGetData(bag,data,ierr);CHKERRA(ierr)
78c4762a1bSJed Brown      call PetscBagSetName(bag,'demo parameters','super secret demo parameters in a bag',ierr);CHKERRA(ierr)
79c4762a1bSJed Brown      call PetscBagSetOptionsPrefix(bag, 'pbag_', ierr);CHKERRA(ierr)
80c4762a1bSJed Brown
81c4762a1bSJed Brown! register the data within the bag, grabbing values from the options database
82c4762a1bSJed Brown!     Need to put the value into a variable for 64 bit indices
83c4762a1bSJed Brown      int56 = 56
84c4762a1bSJed Brown      call PetscBagRegisterInt(bag,data%nxc ,int56,'nxc','nxc_variable help message',ierr);CHKERRA(ierr)
85c4762a1bSJed Brown      call PetscBagRegisterRealArray(bag,data%rarray,three,'rarray','rarray help message',ierr);CHKERRA(ierr)
86c4762a1bSJed Brown!     Need to put the value into a variable to pass correctly for 128 bit quad precision numbers
87c4762a1bSJed Brown      svalue = 103.20
88c4762a1bSJed Brown      call PetscBagRegisterScalar(bag,data%x ,svalue,'x','x variable help message',ierr);CHKERRA(ierr)
89c4762a1bSJed Brown      call PetscBagRegisterBool(bag,data%t ,PETSC_TRUE,'t','t boolean help message',ierr);CHKERRA(ierr)
90c4762a1bSJed Brown      call PetscBagRegisterBoolArray(bag,data%tarray,three,'tarray','tarray help message',ierr);CHKERRA(ierr)
91c4762a1bSJed Brown      call PetscBagRegisterString(bag,data%c,'hello','c','string help message',ierr);CHKERRA(ierr)
92c4762a1bSJed Brown      value = -11.00
93c4762a1bSJed Brown      call PetscBagRegisterReal(bag,data%y ,value,'y','y variable help message',ierr);CHKERRA(ierr)
94c4762a1bSJed Brown      value = 1.00
95c4762a1bSJed Brown      call PetscBagRegisterReal(bag,data%pos%x1 ,value,'pos_x1','tuple value 1 help message',ierr);CHKERRA(ierr)
96c4762a1bSJed Brown      value = 2.00
97c4762a1bSJed Brown      call PetscBagRegisterReal(bag,data%pos%x2 ,value,'pos_x2','tuple value 2 help message',ierr);CHKERRA(ierr)
98c4762a1bSJed Brown      call PetscBagRegisterEnum(bag,data%enum ,list,1,'enum','tuple value 2 help message',ierr);CHKERRA(ierr)
99c4762a1bSJed Brown      call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
100c4762a1bSJed Brown
101c4762a1bSJed Brown      data%nxc = 23
102c4762a1bSJed Brown      data%rarray(1) = -1.0
103c4762a1bSJed Brown      data%rarray(2) = -2.0
104c4762a1bSJed Brown      data%rarray(3) = -3.0
105c4762a1bSJed Brown      data%x   = 155.4
106c4762a1bSJed Brown      data%c   = 'a whole new string'
107c4762a1bSJed Brown      data%t   = PETSC_TRUE
108c4762a1bSJed Brown      data%tarray   = (/PETSC_TRUE,PETSC_FALSE,PETSC_TRUE/)
109c4762a1bSJed Brown      call PetscBagView(bag,PETSC_VIEWER_BINARY_WORLD,ierr);CHKERRA(ierr)
110c4762a1bSJed Brown
111c4762a1bSJed Brown      call PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',FILE_MODE_READ,viewer,ierr);CHKERRA(ierr)
112c4762a1bSJed Brown      call PetscBagLoad(viewer,bag,ierr);CHKERRA(ierr)
113c4762a1bSJed Brown      call PetscViewerDestroy(viewer,ierr);CHKERRA(ierr)
114c4762a1bSJed Brown      call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
115c4762a1bSJed Brown
116c4762a1bSJed Brown      call PetscBagSetFromOptions(bag,ierr);CHKERRA(ierr)
117c4762a1bSJed Brown      call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
118c4762a1bSJed Brown      call PetscBagDestroy(bag,ierr);CHKERRA(ierr)
119c4762a1bSJed Brown
120c4762a1bSJed Brown      call PetscFinalize(ierr)
121c4762a1bSJed Brown      end program ex5f90
122c4762a1bSJed Brown
123c4762a1bSJed Brown!
124c4762a1bSJed Brown!/*TEST
125c4762a1bSJed Brown!
126c4762a1bSJed Brown!   build:
127*dfd57a17SPierre Jolivet!      requires: defined(PETSC_USING_F2003) defined(PETSC_USING_F90FREEFORM)
128c4762a1bSJed Brown!
129c4762a1bSJed Brown!   test:
130c4762a1bSJed Brown!      args: -pbag_rarray 4,5,88
131c4762a1bSJed Brown!
132c4762a1bSJed Brown!TEST*/
133