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 if (x1(i) .ne. x(i)) then 67 SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match") 68 end if 69 end do 70 PetscCallA(PetscSortIntWithArray(N,y,x,ierr)) 71 PetscCallA(PetscSortIntWithArrayPair(N,x,y,z,ierr)) 72 73 PetscCallA(PetscSortMPIInt(N,mx,ierr)) 74 PetscCallA(PetscSortMPIIntWithArray(mN,mx,my,ierr)) 75 PetscCallA(PetscSortMPIIntWithIntArray(mN,mx,y,ierr)) 76 77 PetscCallA(PetscSortIntWithScalarArray(N,x,s,ierr)) 78 79 PetscCallA(PetscSortReal(N,r,ierr)) 80 PetscCallA(PetscSortRealWithArrayInt(N,r,x,ierr)) 81 82 PetscCallA(PetscFinalize(ierr)) 83end program main 84 85!/*TEST 86! 87! test: 88! 89!TEST*/ 90