1: #include <petsc/finclude/petscsys.h>
  2: #include <petsc/finclude/petscbag.h>
  3: #include <petsc/finclude/petscviewer.h>

  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

 11:   type tuple
 12:     PetscReal:: x1, x2
 13:   end type tuple

 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

 28: module ex5f90Bag_interface_module
 29:   use ex5f90module

 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

 41: program ex5f90
 42:   use ex5f90Bag_interface_module
 43:   use petsc
 44:   implicit none

 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

 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

 68: !   compute size of the data
 69: !
 70:   sizeofbag = size(transfer(dummydata, dummychar))

 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))

 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))

 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))

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))

113:   PetscCallA(PetscBagSetFromOptions(bag, ierr))
114:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
115:   PetscCallA(PetscBagDestroy(bag, ierr))

117:   PetscCallA(PetscFinalize(ierr))
118: end program ex5f90

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*/