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

  5: module ex5module
  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 ex5module

 28: program ex5f90
 29:   use ex5module
 30:   use petsc
 31:   implicit none

 33:   PetscBag bag
 34:   PetscErrorCode ierr
 35:   type(bag_data_type), pointer :: data
 36:   type(bag_data_type)          :: dummydata
 37:   character(len=1), pointer     :: dummychar(:)
 38:   PetscViewer viewer
 39:   PetscSizeT sizeofbag
 40:   character(len=99) list(6)
 41:   PetscInt three, int56
 42:   PetscReal value
 43:   PetscScalar svalue

 45:   PetscCallA(PetscInitialize(ierr))
 46:   list(1) = 'a123'
 47:   list(2) = 'b456'
 48:   list(3) = 'c789'
 49:   list(4) = 'list'
 50:   list(5) = 'prefix_'
 51:   list(6) = ''
 52: !     cannot just pass a 3 to PetscBagRegisterXXXArray() because it is expecting a PetscInt
 53:   three = 3

 55: !   compute size of the data
 56: !
 57:   sizeofbag = size(transfer(dummydata, dummychar))

 59: ! create the bag
 60:   PetscCallA(PetscBagCreate(PETSC_COMM_WORLD, sizeofbag, bag, ierr))
 61:   PetscCallA(PetscBagGetData(bag, data, ierr))
 62:   PetscCallA(PetscBagSetName(bag, 'demo parameters', 'super secret demo parameters in a bag', ierr))
 63:   PetscCallA(PetscBagSetOptionsPrefix(bag, 'pbag_', ierr))

 65: ! register the data within the bag, grabbing values from the options database
 66: !     Need to put the value into a variable for 64-bit indices
 67:   int56 = 56
 68:   PetscCallA(PetscBagRegisterInt(bag, data%nxc, int56, 'nxc', 'nxc_variable help message', ierr))
 69:   PetscCallA(PetscBagRegisterRealArray(bag, data%rarray, three, 'rarray', 'rarray help message', ierr))
 70: !     Need to put the value into a variable to pass correctly for 128 bit quad precision numbers
 71:   svalue = 103.20
 72:   PetscCallA(PetscBagRegisterScalar(bag, data%x, svalue, 'x', 'x variable help message', ierr))
 73:   PetscCallA(PetscBagRegisterBool(bag, data%t, PETSC_TRUE, 't', 't boolean help message', ierr))
 74:   PetscCallA(PetscBagRegisterBoolArray(bag, data%tarray, three, 'tarray', 'tarray help message', ierr))
 75:   PetscCallA(PetscBagRegisterString(bag, data%c, 'hello', 'c', 'string help message', ierr))
 76:   value = -11.00
 77:   PetscCallA(PetscBagRegisterReal(bag, data%y, value, 'y', 'y variable help message', ierr))
 78:   value = 1.00
 79:   PetscCallA(PetscBagRegisterReal(bag, data%pos%x1, value, 'pos_x1', 'tuple value 1 help message', ierr))
 80:   value = 2.00
 81:   PetscCallA(PetscBagRegisterReal(bag, data%pos%x2, value, 'pos_x2', 'tuple value 2 help message', ierr))
 82:   PetscCallA(PetscBagRegisterEnum(bag, data%enum, list, 1, 'enum', 'tuple value 2 help message', ierr))
 83:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))

 85:   data%nxc = 23
 86:   data%rarray(1) = -1.0
 87:   data%rarray(2) = -2.0
 88:   data%rarray(3) = -3.0
 89:   data%x = 155.4
 90:   data%c = 'a whole new string'
 91:   data%t = PETSC_TRUE
 92:   data%tarray = (/PETSC_TRUE, PETSC_FALSE, PETSC_TRUE/)
 93:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_BINARY_WORLD, ierr))

 95:   PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD, 'binaryoutput', FILE_MODE_READ, viewer, ierr))
 96:   PetscCallA(PetscBagLoad(viewer, bag, ierr))
 97:   PetscCallA(PetscViewerDestroy(viewer, ierr))
 98:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))

100:   PetscCallA(PetscBagSetFromOptions(bag, ierr))
101:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
102:   PetscCallA(PetscBagDestroy(bag, ierr))

104:   PetscCallA(PetscFinalize(ierr))
105: end program ex5f90

107: !
108: !/*TEST
109: !
110: !   test:
111: !      args: -pbag_rarray 4,5,88
112: !
113: !TEST*/