Actual source code: ex17f.F

petsc-3.12.1 2019-10-22
Report Typos and Errors
  1: !
  2: !
  3: !     Test for PetscFOpen() from Fortran
  4: !
  5:        program main
  6:  #include <petsc/finclude/petscsys.h>
  7:        use petscsys
  8:        implicit none

 10:       PetscErrorCode ierr
 11:       PetscMPIInt rank
 12:       PetscFortranAddr file
 13:       character*100    joe

 15:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 16:       if (ierr .ne. 0) then
 17:          print*,'Unable to initialize PETSc'
 18:          stop
 19:       endif
 20:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)

 22:       call PetscFOpen(PETSC_COMM_WORLD,'testfile','w',file,ierr)

 24:       call PetscFPrintf(PETSC_COMM_WORLD,file,'Hi once \n',ierr)
 25:       call PetscSynchronizedFPrintf(PETSC_COMM_WORLD,file,'Hi twice \n',     &
 26:      &                              ierr)
 27:       call PetscSynchronizedFlush(PETSC_COMM_WORLD,file,ierr)

 29:       write (FMT=*,UNIT=joe) 'greetings from ',rank,'\n'
 30:       call PetscSynchronizedFPrintf(PETSC_COMM_WORLD,file,joe,ierr)
 31:       call PetscSynchronizedFlush(PETSC_COMM_WORLD,file,ierr)

 33:       call PetscFClose(PETSC_COMM_WORLD,file,ierr)

 35:       call PetscSynchronizedPrintf(PETSC_COMM_WORLD,'Hi twice \n',          &
 36:      &                              ierr)
 37:       call PetscSynchronizedFlush(PETSC_COMM_WORLD,PETSC_STDOUT,ierr)

 39:       call PetscFinalize(ierr)
 40:       end

 42: !
 43: !/*TEST
 44: !
 45: !   test:
 46: !      nsize: 3
 47: !
 48: !TEST*/