Actual source code: ex5f90.F90

  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:          PetscBool  :: t
 19:          character*(80) :: c
 20:          type(tuple) :: pos
 21:       end type bag_data_type
 22:       end module Bag_data_module

 24:       module Bag_interface_module
 25:       use Bag_data_module

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

 37:       program ex5f90
 38:       use Bag_interface_module
 39: !     use Bag_module
 40:       use petsc
 41:       implicit none

 43:       PetscBag bag
 44:       PetscErrorCode ierr
 45:       type(bag_data_type), pointer :: data
 46:       PetscViewer viewer
 47:       PetscSizeT sizeofbag,sizeofint
 48:       PetscSizeT sizeofscalar,sizeoftruth
 49:       PetscSizeT sizeofchar,sizeofreal

 51:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 53: !   compute size of the data
 54:       call PetscDataTypeGetSize(PETSC_INT,sizeofint,ierr)
 55:       call PetscDataTypeGetSize(PETSC_SCALAR,sizeofscalar,ierr)
 56:       call PetscDataTypeGetSize(PETSC_BOOL,sizeoftruth,ierr)
 57:       call PetscDataTypeGetSize(PETSC_CHAR,sizeofchar,ierr)
 58:       call PetscDataTypeGetSize(PETSC_REAL,sizeofreal,ierr)

 60: !     really need a sizeof(data) operator here. There could be padding inside the
 61: !     structure due to alignment issues - so, this computed value cold be wrong.
 62:       sizeofbag = sizeofint + sizeofscalar + sizeoftruth + sizeofchar*80 &
 63:      &       + 3*sizeofreal

 65: ! create the bag
 66:       call PetscBagCreate(PETSC_COMM_WORLD,sizeofbag,bag,ierr)
 67:       call PetscBagGetData(bag,data,ierr)
 68:       call PetscBagSetName(bag,'demo parameters',                        &
 69:      &      'super secret demo parameters in a bag',ierr)
 70:       call PetscBagSetOptionsPrefix(bag, 'pbag_', ierr)

 72: ! register the data within the bag, grabbing values from the options database
 73:       call PetscBagRegisterInt(bag,data%nxc ,56,'nxc',                   &
 74:      &      'nxc_variable help message',ierr)
 75:       call PetscBagRegisterScalar(bag,data%x ,103.2d0,'x',               &
 76:      &      'x variable help message',ierr)
 77:       call PetscBagRegisterBool(bag,data%t ,PETSC_TRUE,'t',              &
 78:      &      't boolean help message',ierr)
 79:       call PetscBagRegisterString(bag,data%c,'hello','c',                &
 80:      &      'string help message',ierr)
 81:       call PetscBagRegisterReal(bag,data%y ,-11.0d0,'y',                 &
 82:      &       'y variable help message',ierr)
 83:       call PetscBagRegisterReal(bag,data%pos%x1 ,1.0d0,'pos_x1',         &
 84:      &      'tuple value 1 help message',ierr)
 85:       call PetscBagRegisterReal(bag,data%pos%x2 ,2.0d0,'pos_x2',         &
 86:      &      'tuple value 2 help message',ierr)
 87:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr)

 89:       data%nxc = 23
 90:       data%x   = 155.4
 91:       data%c   = 'a whole new string'
 92:       data%t   = PETSC_TRUE
 93:       call PetscBagView(bag,PETSC_VIEWER_BINARY_WORLD,ierr)
 94:       call PetscBagDestroy(bag,ierr)

 96:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',        &
 97:      &      FILE_MODE_READ,viewer,ierr)
 98:       call PetscBagLoad(viewer,bag,ierr)
 99:       call PetscViewerDestroy(viewer,ierr)
100:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr)
101:       call PetscBagDestroy(bag,ierr)

103:       call PetscFinalize(ierr)
104:       end program ex5f90