Actual source code: ex49f.F90
1: !
2: ! Test Fortran binding of sort routines
3: !
4: module ex49fmodule
5: use petsc
6: #include "petsc/finclude/petsc.h"
7: implicit none
8: type uctx
9: PetscInt myint
10: end type uctx
11: contains
12: subroutine CompareIntegers(a, b, ctx, res)
13: implicit none
15: PetscInt :: a, b
16: type(uctx) :: ctx
17: integer :: res
19: if (a < b) then
20: res = -1
21: else if (a == b) then
22: res = 0
23: else
24: res = 1
25: end if
26: end subroutine CompareIntegers
27: end module ex49fmodule
29: program main
31: use ex49fmodule
32: implicit none
34: PetscErrorCode ierr
35: PetscCount, parameter:: iN = 3
36: PetscInt, parameter :: N = 3
37: PetscInt x(N), x1(N), y(N), z(N)
38: PetscMPIInt mx(N), my(N)
39: PetscScalar s(N)
40: PetscReal r(N)
41: PetscMPIInt, parameter:: two = 2, five = 5, seven = 7
42: type(uctx):: ctx
43: PetscInt i
44: PetscSizeT sizeofentry
46: PetscCallA(PetscInitialize(ierr))
48: x = [3, 2, 1]
49: x1 = [3, 2, 1]
50: y = [6, 5, 4]
51: z = [3, 5, 2]
52: mx = [five, seven, two]
53: my = [five, seven, two]
54: s = [1.0, 2.0, 3.0]
55: r = [1.0, 2.0, 3.0]
56: #if defined(PETSC_USE_64BIT_INDICES)
57: sizeofentry = 8
58: #else
59: sizeofentry = 4
60: #endif
61: ctx%myint = 1
62: PetscCallA(PetscSortInt(iN, x, ierr))
63: PetscCallA(PetscTimSort(N, x1, sizeofentry, CompareIntegers, ctx, ierr))
64: do i = 1, N
65: PetscCheckA(x1(i) == x(i), PETSC_COMM_SELF, PETSC_ERR_PLIB, 'PetscTimSort and PetscSortInt arrays did not match')
66: end do
67: PetscCallA(PetscSortIntWithArray(iN, y, x, ierr))
68: PetscCallA(PetscSortIntWithArrayPair(iN, x, y, z, ierr))
70: PetscCallA(PetscSortMPIInt(iN, mx, ierr))
71: PetscCallA(PetscSortMPIIntWithArray(iN, mx, my, ierr))
72: PetscCallA(PetscSortMPIIntWithIntArray(iN, mx, y, ierr))
74: PetscCallA(PetscSortIntWithScalarArray(iN, x, s, ierr))
76: PetscCallA(PetscSortReal(iN, r, ierr))
77: PetscCallA(PetscSortRealWithArrayInt(iN, r, x, ierr))
79: PetscCallA(PetscFinalize(ierr))
80: end program main
82: !/*TEST
83: !
84: ! test:
85: ! output_file: output/empty.out
86: !
87: !TEST*/