Actual source code: ex5f90.F90
petsc-3.12.4 2020-02-04
Report Typos and Errors

      1: #define PETSC_USE_FORTRAN_MODULES 1

      3:  #include <petsc/finclude/petscsys.h>
      4:  #include <petsc/finclude/petscbag.h>
      5:  #include <petsc/finclude/petscviewer.h>

      7:       module Bag_data_module
      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 Bag_data_module

     28:       module Bag_interface_module
     29:       use Bag_data_module

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

     41:       program ex5f90
     42:       use Bag_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:       Call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     59:       if (ierr .ne. 0) then
     60:          print*,'Unable to initialize PETSc'
     61:          stop
     62:       endif
     63:       list(1) = 'a123'
     64:       list(2) = 'b456'
     65:       list(3) = 'c789'
     66:       list(4) = 'list'
     67:       list(5) = 'prefix_'
     68:       list(6) = ''
     69: !     cannot just pass a 3 to PetscBagRegisterXXXArray() because it is expecting a PetscInt
     70:       three   = 3

     72: !   compute size of the data
     73: !
     74:       sizeofbag = size(transfer(dummydata,dummychar))

     77: ! create the bag
     78:       call PetscBagCreate(PETSC_COMM_WORLD,sizeofbag,bag,ierr);CHKERRA(ierr)
     79:       call PetscBagGetData(bag,data,ierr);CHKERRA(ierr)
     80:       call PetscBagSetName(bag,'demo parameters','super secret demo parameters in a bag',ierr);CHKERRA(ierr)
     81:       call PetscBagSetOptionsPrefix(bag, 'pbag_', ierr);CHKERRA(ierr)

     83: ! register the data within the bag, grabbing values from the options database
     84: !     Need to put the value into a variable for 64 bit indices
     85:       int56 = 56
     86:       call PetscBagRegisterInt(bag,data%nxc ,int56,'nxc','nxc_variable help message',ierr);CHKERRA(ierr)
     87:       call PetscBagRegisterRealArray(bag,data%rarray,three,'rarray','rarray help message',ierr);CHKERRA(ierr)
     88: !     Need to put the value into a variable to pass correctly for 128 bit quad precision numbers
     89:       svalue = 103.20
     90:       call PetscBagRegisterScalar(bag,data%x ,svalue,'x','x variable help message',ierr);CHKERRA(ierr)
     91:       call PetscBagRegisterBool(bag,data%t ,PETSC_TRUE,'t','t boolean help message',ierr);CHKERRA(ierr)
     92:       call PetscBagRegisterBoolArray(bag,data%tarray,three,'tarray','tarray help message',ierr);CHKERRA(ierr)
     93:       call PetscBagRegisterString(bag,data%c,'hello','c','string help message',ierr);CHKERRA(ierr)
     94:       value = -11.00
     95:       call PetscBagRegisterReal(bag,data%y ,value,'y','y variable help message',ierr);CHKERRA(ierr)
     96:       value = 1.00
     97:       call PetscBagRegisterReal(bag,data%pos%x1 ,value,'pos_x1','tuple value 1 help message',ierr);CHKERRA(ierr)
     98:       value = 2.00
     99:       call PetscBagRegisterReal(bag,data%pos%x2 ,value,'pos_x2','tuple value 2 help message',ierr);CHKERRA(ierr)
    100:       call PetscBagRegisterEnum(bag,data%enum ,list,1,'enum','tuple value 2 help message',ierr);CHKERRA(ierr)
    101:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)

    103:       data%nxc = 23
    104:       data%rarray(1) = -1.0
    105:       data%rarray(2) = -2.0
    106:       data%rarray(3) = -3.0
    107:       data%x   = 155.4
    108:       data%c   = 'a whole new string'
    109:       data%t   = PETSC_TRUE
    110:       data%tarray   = (/PETSC_TRUE,PETSC_FALSE,PETSC_TRUE/)
    111:       call PetscBagView(bag,PETSC_VIEWER_BINARY_WORLD,ierr);CHKERRA(ierr)

    113:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',FILE_MODE_READ,viewer,ierr);CHKERRA(ierr)
    114:       call PetscBagLoad(viewer,bag,ierr);CHKERRA(ierr)
    115:       call PetscViewerDestroy(viewer,ierr);CHKERRA(ierr)
    116:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)

    118:       call PetscBagSetFromOptions(bag,ierr);CHKERRA(ierr)
    119:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
    120:       call PetscBagDestroy(bag,ierr);CHKERRA(ierr)

    122:       call PetscFinalize(ierr)
    123:       end program ex5f90

    125: !
    126: !/*TEST
    127: !
    128: !   build:
    129: !      requires: define(PETSC_USING_F2003) define(PETSC_USING_F90FREEFORM)
    130: !
    131: !   test:
    132: !      args: -pbag_rarray 4,5,88
    133: !
    134: !TEST*/