Actual source code: ex5f90.F90

petsc-master 2017-06-21
Report Typos and Errors
  1: #define PETSC_USE_FORTRAN_MODULES 1
  2: !/*T
  3: !   requires: define(PETSC_USING_F2003) define(PETSC_USING_F90FREEFORM)
  4: !T*/

  6:  #include <petsc/finclude/petscsys.h>
  7:  #include <petsc/finclude/petscbag.h>
  8:  #include <petsc/finclude/petscviewer.h>

 10:       module Bag_data_module
 11: !     Data structure used to contain information about the problem
 12: !     You can add physical values etc here

 14:       type tuple
 15:          PetscReal:: x1,x2
 16:       end type tuple

 18:       type bag_data_type
 19:          PetscScalar :: x
 20:          PetscReal :: y
 21:          PetscInt  :: nxc
 22:          PetscReal :: rarray(3)
 23:          PetscBool  :: t
 24:          PetscBool  :: tarray(3)
 25:          PetscEnum :: enum
 26:          character*(80) :: c
 27:          type(tuple) :: pos
 28:       end type bag_data_type
 29:       end module Bag_data_module

 31:       module Bag_interface_module
 32:       use Bag_data_module

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

 44:       program ex5f90
 45:       use Bag_interface_module
 46:       use petsc
 47:       implicit none

 49:       PetscBag bag
 50:       PetscErrorCode ierr
 51:       type(bag_data_type), pointer :: data
 52:       type(bag_data_type)          :: dummydata
 53:       character(len=1),pointer     :: dummychar(:)
 54:       PetscViewer viewer
 55:       PetscSizeT sizeofbag
 56:       Character(len=99) list(6)
 57:       PetscInt three,int56
 58:       PetscReal value
 59:       PetscScalar svalue

 61:       Call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 62:       if (ierr .ne. 0) then
 63:          print*,'Unable to initialize PETSc'
 64:          stop
 65:       endif
 66:       list(1) = 'a123'
 67:       list(2) = 'b456'
 68:       list(3) = 'c789'
 69:       list(4) = 'list'
 70:       list(5) = 'prefix_'
 71:       list(6) = ''
 72: !     cannot just pass a 3 to PetscBagRegisterXXXArray() because it is expecting a PetscInt
 73:       three   = 3

 75: !   compute size of the data
 76: !
 77:       sizeofbag = size(transfer(dummydata,dummychar))


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

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

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

116:       call PetscViewerBinaryOpen(PETSC_COMM_WORLD,'binaryoutput',FILE_MODE_READ,viewer,ierr);CHKERRQ(ierr)
117:       call PetscBagLoad(viewer,bag,ierr);CHKERRQ(ierr)
118:       call PetscViewerDestroy(viewer,ierr);CHKERRQ(ierr)
119:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)

121:       call PetscBagSetFromOptions(bag,ierr);CHKERRQ(ierr)
122:       call PetscBagView(bag,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRQ(ierr)
123:       call PetscBagDestroy(bag,ierr);CHKERRQ(ierr)

125:       call PetscFinalize(ierr)
126:       end program ex5f90

128: !
129: !/*TEST
130: !
131: !   test:
132: !      args: -pbag_rarray 4,5,88
133: !
134: !TEST*/