1: #define PETSC_USE_FORTRAN_MODULES 1
  2: #include <finclude/petscsysdef.h>
  3: #include <finclude/petscbagdef.h>
  4: #include <finclude/petscviewerdef.h>

  6:       module Bag_data_module
  7: !     Data structure used to contain information about the problem
  8: !     You can add physical values etc here

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

 14:       type bag_data_type
 15:          PetscScalar :: x
 16:          PetscReal :: y
 17:          PetscInt  :: nxc
 18:          PetscReal :: rarray(3)
 19:          PetscBool  :: t
 20:          PetscEnum :: enum
 21:          character*(80) :: c
 22:          type(tuple) :: pos
 23:       end type bag_data_type
 24:       end module Bag_data_module

 26:       module Bag_interface_module
 27:       use Bag_data_module

 29:       interface PetscBagGetData
 30:          subroutine PetscBagGetData(bag,data,ierr)
 31:            use Bag_data_module
 32:            PetscBag bag
 33:            type(bag_data_type),pointer :: data
 34:            PetscErrorCode ierr
 35:          end subroutine PetscBagGetData
 36:       end interface
 37:       end module Bag_interface_module

 39:       program ex5f90
 40:       use Bag_interface_module
 41:       use petsc
 42:       implicit none

 44:       PetscBag bag
 45:       PetscErrorCode ierr
 46:       type(bag_data_type), pointer :: data
 47:       type(bag_data_type)          :: dummydata
 48:       character(len=1),pointer     :: dummychar(:)
 49:       PetscViewer viewer
 50:       PetscSizeT sizeofbag,sizeofint
 51:       PetscSizeT sizeofscalar,sizeoftruth
 52:       PetscSizeT sizeofchar,sizeofreal
 53:       Character(len=99) list(6)
 54: 
 55:       Call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 56:       list(1) = 'a123'
 57:       list(2) = 'b456'
 58:       list(3) = 'c789'
 59:       list(4) = 'list'
 60:       list(5) = 'prefix_'
 61:       list(6) = ''

 63: !   compute size of the data
 64: !      call PetscDataTypeGetSize(PETSC_INT,sizeofint,ierr)
 65: !      call PetscDataTypeGetSize(PETSC_SCALAR,sizeofscalar,ierr)
 66: !      call PetscDataTypeGetSize(PETSC_BOOL,sizeoftruth,ierr)
 67:        call PetscDataTypeGetSize(PETSC_CHAR,sizeofchar,ierr)
 68: !      call PetscDataTypeGetSize(PETSC_REAL,sizeofreal,ierr)

 70: !     really need a sizeof(data) operator here. There could be padding inside the
 71: !     structure due to alignment issues - so, this computed value cold be wrong.
 72: !      sizeofbag = sizeofint + sizeofscalar + sizeoftruth + sizeofchar*80 &
 73: !     &       + 3*sizeofreal+3*sizeofreal
 74: !     That is correct... unless the sequence keyword is used in the derived
 75: !     types, this length will be wrong because of padding
 76: !     this is a situation where the transfer function is very helpful...
 77:       sizeofbag = size(transfer(dummydata,dummychar))*sizeofchar
 78: 

 80: ! create the bag
 81:       call PetscBagCreate(PETSC_COMM_WORLD,sizeofbag,bag,ierr)
 82:       call PetscBagGetData(bag,data,ierr)
 83:       call PetscBagSetName(bag,'demo parameters',                        &
 84:      &      'super secret demo parameters in a bag',ierr)
 85:       call PetscBagSetOptionsPrefix(bag, 'pbag_', ierr)

 87: ! register the data within the bag, grabbing values from the options database
 88:       call PetscBagRegisterInt(bag,data%nxc ,56,'nxc',                   &
 89:      &      'nxc_variable help message',ierr)
 90:       call PetscBagRegisterRealArray(bag,data%rarray ,3,'rarray',        &
 91:      &      'rarray help message',ierr)
 92:       call PetscBagRegisterScalar(bag,data%x ,103.2d0,'x',               &
 93:      &      'x variable help message',ierr)
 94:       call PetscBagRegisterBool(bag,data%t ,PETSC_TRUE,'t',              &
 95:      &      't boolean help message',ierr)
 96:       call PetscBagRegisterString(bag,data%c,'hello','c',                &
 97:      &      'string help message',ierr)
 98:       call PetscBagRegisterReal(bag,data%y ,-11.0d0,'y',                 &
 99:      &       'y variable help message',ierr)
100:       call PetscBagRegisterReal(bag,data%pos%x1 ,1.0d0,'pos_x1',         &
101:      &      'tuple value 1 help message',ierr)
102:       call PetscBagRegisterReal(bag,data%pos%x2 ,2.0d0,'pos_x2',         &
103:      &      'tuple value 2 help message',ierr)
104:       call PetscBagRegisterEnum(bag,data%enum ,list,1,'enum',            &
105:      &      'tuple value 2 help message',ierr)
106:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr)

108:       data%nxc = 23
109:       data%rarray(1) = -1.0
110:       data%rarray(2) = -2.0
111:       data%rarray(3) = -3.0
112:       data%x   = 155.4
113:       data%c   = 'a whole new string'
114:       data%t   = PETSC_TRUE
115:       call PetscBagView(bag,PETSC_VIEWER_BINARY_WORLD,ierr)

117:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',        &
118:      &      FILE_MODE_READ,viewer,ierr)
119:       call PetscBagLoad(viewer,bag,ierr)
120:       call PetscViewerDestroy(viewer,ierr)
121:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr)
122: 
123:       call PetscBagSetFromOptions(bag,ierr)
124:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr)
125:       call PetscBagDestroy(bag,ierr)

127:       call PetscFinalize(ierr)
128:       end program ex5f90