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 return 27 end subroutine CompareIntegers 28end module ex49fmodule 29 30program main 31 32 use ex49fmodule 33 implicit none 34 35 PetscErrorCode ierr 36 PetscInt,parameter:: N=3 37 PetscMPIInt,parameter:: mN=3 38 PetscInt x(N),x1(N),y(N),z(N) 39 PetscMPIInt mx(N),my(N) 40 PetscScalar s(N) 41 PetscReal r(N) 42 PetscMPIInt,parameter:: two=2, five=5, seven=7 43 type(uctx):: ctx 44 PetscInt i 45 PetscSizeT sizeofentry 46 47 PetscCallA(PetscInitialize(ierr)) 48 49 x = [3, 2, 1] 50 x1 = [3, 2, 1] 51 y = [6, 5, 4] 52 z = [3, 5, 2] 53 mx = [five, seven, two] 54 my = [five, seven, two] 55 s = [1.0, 2.0, 3.0] 56 r = [1.0, 2.0, 3.0] 57#if defined(PETSC_USE_64BIT_INDICES) 58 sizeofentry = 8; 59#else 60 sizeofentry = 4; 61#endif 62 ctx%myint = 1 63 PetscCallA(PetscSortInt(N,x,ierr)) 64 PetscCallA(PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr)) 65 do i = 1,N 66 PetscCheckA(x1(i) .eq. x(i),PETSC_COMM_SELF,PETSC_ERR_PLIB,'PetscTimSort and PetscSortInt arrays did not match') 67 end do 68 PetscCallA(PetscSortIntWithArray(N,y,x,ierr)) 69 PetscCallA(PetscSortIntWithArrayPair(N,x,y,z,ierr)) 70 71 PetscCallA(PetscSortMPIInt(N,mx,ierr)) 72 PetscCallA(PetscSortMPIIntWithArray(mN,mx,my,ierr)) 73 PetscCallA(PetscSortMPIIntWithIntArray(mN,mx,y,ierr)) 74 75 PetscCallA(PetscSortIntWithScalarArray(N,x,s,ierr)) 76 77 PetscCallA(PetscSortReal(N,r,ierr)) 78 PetscCallA(PetscSortRealWithArrayInt(N,r,x,ierr)) 79 80 PetscCallA(PetscFinalize(ierr)) 81end program main 82 83!/*TEST 84! 85! test: 86! 87!TEST*/ 88