Date: 2013-07-02T14:39:26+00:00

Actual source code: ex5f90.F90
petsc-3.4.2 2013-07-02

      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)

     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

     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)

    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