Actual source code: ex5f90.F90

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