Actual source code: ex17f.F
petsc-3.13.4 2020-08-01
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*/