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) 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 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 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 call PetscSortInt(N,x,ierr) 64 call 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 call PetscSortIntWithArray(N,y,x,ierr) 71 call PetscSortIntWithArrayPair(N,x,y,z,ierr) 72 73 call PetscSortMPIInt(N,mx,ierr) 74 call PetscSortMPIIntWithArray(mN,mx,my,ierr) 75 call PetscSortMPIIntWithIntArray(mN,mx,y,ierr) 76 77 call PetscSortIntWithScalarArray(N,x,s,ierr) 78 79 call PetscSortReal(N,r,ierr) 80 call PetscSortRealWithArrayInt(N,r,x,ierr) 81 82 call PetscFinalize(ierr) 83end program main 84 85!/*TEST 86! 87! test: 88! 89!TEST*/ 90