1! 2! Test Fortran binding of sort routines 3! 4#include "petsc/finclude/petsc.h" 5module ex49fmodule 6 use petsc 7 implicit none 8 type uctx 9 PetscInt myint 10 end type uctx 11contains 12 subroutine CompareIntegers(a, b, ctx, res) 13 implicit none 14 15 PetscInt :: a, b 16 type(uctx) :: ctx 17 integer :: res 18 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 27end module ex49fmodule 28 29program main 30 31 use ex49fmodule 32 implicit none 33 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 45 46 PetscCallA(PetscInitialize(ierr)) 47 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)) 69 70 PetscCallA(PetscSortMPIInt(iN, mx, ierr)) 71 PetscCallA(PetscSortMPIIntWithArray(iN, mx, my, ierr)) 72 PetscCallA(PetscSortMPIIntWithIntArray(iN, mx, y, ierr)) 73 74 PetscCallA(PetscSortIntWithScalarArray(iN, x, s, ierr)) 75 76 PetscCallA(PetscSortReal(iN, r, ierr)) 77 PetscCallA(PetscSortRealWithArrayInt(iN, r, x, ierr)) 78 79 PetscCallA(PetscFinalize(ierr)) 80end program main 81 82!/*TEST 83! 84! test: 85! output_file: output/empty.out 86! 87!TEST*/ 88