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(len=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:   PetscReal value
 42:   PetscScalar svalue

 44:   PetscCallA(PetscInitialize(ierr))
 45:   list(1) = 'a123'
 46:   list(2) = 'b456'
 47:   list(3) = 'c789'
 48:   list(4) = 'list'
 49:   list(5) = 'prefix_'
 50:   list(6) = ''

 52: !   compute size of the data
 53: !
 54:   sizeofbag = size(transfer(dummydata, dummychar))

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

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

 80:   data%nxc = 23
 81:   data%rarray = [-1.0, -2.0, -3.0]
 82:   data%x = 155.4_PETSC_SCALAR_KIND
 83:   data%c = 'a whole new string'
 84:   data%t = PETSC_TRUE
 85:   data%tarray = [PETSC_TRUE, PETSC_FALSE, PETSC_TRUE]
 86:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_BINARY_WORLD, ierr))

 88:   PetscCallA(PetscViewerBinaryOpen(PETSC_COMM_WORLD, 'binaryoutput', FILE_MODE_READ, viewer, ierr))
 89:   PetscCallA(PetscBagLoad(viewer, bag, ierr))
 90:   PetscCallA(PetscViewerDestroy(viewer, ierr))
 91:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))

 93:   PetscCallA(PetscBagSetFromOptions(bag, ierr))
 94:   PetscCallA(PetscBagView(bag, PETSC_VIEWER_STDOUT_WORLD, ierr))
 95:   PetscCallA(PetscBagDestroy(bag, ierr))

 97:   PetscCallA(PetscFinalize(ierr))
 98: end program ex5f90

100: !
101: !/*TEST
102: !
103: !   test:
104: !      args: -pbag_rarray 4,5,88
105: !
106: !TEST*/