1! 2! Test Fortran binding of sort routines 3! 4module UserContext 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 UserContext 29 30program main 31 32 use UserContext 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),mz(N) 40 PetscScalar s(N) 41 PetscReal r(N) 42 PetscMPIInt,parameter:: two=2, five=5, seven=7 43 type(uctx):: ctx 44 PetscInt dummyint, i 45 PetscSizeT sizeofentry 46 47 call PetscInitialize(PETSC_NULL_CHARACTER,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 mz = [five, seven, two] 56 s = [1.0, 2.0, 3.0] 57 r = [1.0, 2.0, 3.0] 58 sizeofentry = sizeof(dummyint) 59 ctx%myint = 1 60 call PetscSortInt(N,x,ierr) 61 call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr) 62 do i = 1,N 63 if (x1(i) .ne. x(i)) then 64 SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match") 65 end if 66 end do 67 call PetscSortIntWithArray(N,y,x,ierr) 68 call PetscSortIntWithArrayPair(N,x,y,z,ierr) 69 70 call PetscSortMPIInt(N,mx,ierr) 71 call PetscSortMPIIntWithArray(mN,mx,my,ierr) 72 call PetscSortMPIIntWithIntArray(mN,mx,y,ierr) 73 74 call PetscSortIntWithScalarArray(N,x,s,ierr) 75 76 call PetscSortReal(N,r,ierr) 77 call PetscSortRealWithArrayInt(N,r,x,ierr) 78 79 call PetscFinalize(ierr) 80end program main 81 82!/*TEST 83! 84! test: 85! 86!TEST*/ 87