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