1! 2! Test Fortran binding of sort routines 3! 4module ex49fmodule 5 use petsc 6#include "petsc/finclude/petsc.h" 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) .eq. 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