xref: /petsc/src/sys/classes/draw/tests/ex5f.F90 (revision f3f2f7f27aa694fd10ea4b6451c5d9a87fd24c72)
1!
2!
3program main
4#include <petsc/finclude/petscsys.h>
5#include <petsc/finclude/petscdraw.h>
6  use petscsys
7  use petscdraw
8  implicit none
9!
10!  This example demonstrates basic use of the Fortran interface for
11!  PetscDraw routines.
12!
13  PetscDraw draw
14  PetscDrawLG lg
15  PetscDrawAxis axis
16  PetscErrorCode ierr
17  PetscBool flg
18  integer4 x, y, width, height
19  PetscReal xd, yd
20  PetscReal ten
21  PetscInt i, n, w, h
22  PetscInt one
23
24  n = 15
25  x = 0
26  y = 0
27  w = 400
28  h = 300
29  ten = 10.0
30  one = 1
31
32  PetscCallA(PetscInitialize(ierr))
33
34!  GetInt requires a PetscInt so have to do this ugly setting
35  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-width', w, flg, ierr))
36  width = int(w, kind=kind(width))
37  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-height', h, flg, ierr))
38  height = int(h, kind=kind(height))
39  PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS, PETSC_NULL_CHARACTER, '-n', n, flg, ierr))
40
41  PetscCallA(PetscDrawCreate(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, x, y, width, height, draw, ierr))
42  PetscCallA(PetscDrawSetFromOptions(draw, ierr))
43
44  PetscCallA(PetscDrawLGCreate(draw, one, lg, ierr))
45  PetscCallA(PetscDrawLGGetAxis(lg, axis, ierr))
46  PetscCallA(PetscDrawAxisSetColors(axis, PETSC_DRAW_BLACK, PETSC_DRAW_RED, PETSC_DRAW_BLUE, ierr))
47  PetscCallA(PetscDrawAxisSetLabels(axis, 'toplabel', 'xlabel', 'ylabel', ierr))
48
49  do 10, i = 0, n - 1
50    xd = real(i) - 5.0
51    yd = xd*xd
52    PetscCallA(PetscDrawLGAddPoint(lg, xd, yd, ierr))
5310  continue
54
55    PetscCallA(PetscDrawLGSetUseMarkers(lg, PETSC_TRUE, ierr))
56    PetscCallA(PetscDrawLGDraw(lg, ierr))
57
58    PetscCallA(PetscSleep(ten, ierr))
59
60    PetscCallA(PetscDrawLGDestroy(lg, ierr))
61    PetscCallA(PetscDrawDestroy(draw, ierr))
62    PetscCallA(PetscFinalize(ierr))
63  end
64
65!/*TEST
66!
67!   build:
68!     requires: x
69!
70!   test:
71!     output_file: output/empty.out
72!
73!TEST*/
74