Actual source code: ex36f.F90

  1: !
  2: !  Program to test PetscRandom, PetscObjectReference() and other PetscObjectXXX functions.
  3: !
  4: program main

  6: #include <petsc/finclude/petscsys.h>
  7:   use petscsys
  8:   implicit none

 10:   PetscErrorCode ierr
 11:   PetscRandom r, q, r2
 12:   PetscScalar rand
 13:   PetscInt ref

 15:   PetscCallA(PetscInitialize(ierr))

 17:   PetscCallA(PetscRandomCreate(PETSC_COMM_WORLD, r, ierr))
 18:   PetscCallA(PetscRandomCreate(PETSC_COMM_WORLD, r2, ierr))
 19:   PetscCallA(PetscRandomSetFromOptions(r, ierr))
 20:   PetscCallA(PetscRandomGetValue(r, rand, ierr))
 21:   print *, 'Random value:', rand

 23:   PetscCallA(PetscObjectReference(r, ierr))
 24:   PetscCallA(PetscObjectGetReference(r, ref, ierr))
 25:   print *, 'Reference value:', ref
 26:   PetscCallA(PetscObjectDereference(r, ierr))

 28:   PetscCallA(PetscObjectCompose(r, 'test', r2, ierr))
 29:   PetscCallA(PetscObjectQuery(r, 'test', q, ierr))
 30:   PetscCheckA(q == r2, PETSC_COMM_SELF, PETSC_ERR_PLIB, 'Object compose/query failed')

 32:   PetscCallA(PetscRandomDestroy(r, ierr))
 33:   PetscCallA(PetscRandomDestroy(r2, ierr))
 34:   PetscCallA(PetscFinalize(ierr))
 35: end

 37: !
 38: !/*TEST
 39: !
 40: !   build:
 41: !     requires: defined(PETSC_HAVE_FORTRAN_TYPE_STAR)
 42: !
 43: !   test:
 44: !     requires: !complex
 45: !
 46: !TEST*/