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