Actual source code: ex36f.F90

petsc-3.12.1 2019-10-22
Report Typos and Errors
  1: !
  2: !  Program to test 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:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 16:       if (ierr .ne. 0) then
 17:          print*, 'Unable to begin PETSc program'
 18:       endif

 20:       call PetscRandomCreate(PETSC_COMM_WORLD,r,ierr)
 21:       call PetscRandomCreate(PETSC_COMM_WORLD,r2,ierr)
 22:       call PetscRandomSetFromOptions(r,ierr)
 23:       call PetscRandomGetValue(r,rand,ierr)
 24:       print*, 'Random value:',rand

 26:       call PetscObjectReference(r,ierr)
 27:       call PetscObjectGetReference(r,ref,ierr)
 28:       print*, 'Reference value:',ref
 29:       call PetscObjectDereference(r,ierr)

 31:       call PetscObjectCompose(r,'test',r2,ierr);
 32:       call PetscObjectQuery(r,'test',q,ierr);
 33:       if (q .ne. r2) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,'Object compose/query failed'); endif

 35:       call PetscRandomDestroy(r,ierr)
 36:       call PetscRandomDestroy(r2,ierr)
 37:       call PetscFinalize(ierr)
 38:       end

 40: !
 41: !/*TEST
 42: !
 43: !   test:
 44: !      requires: !complex
 45: !
 46: !TEST*/