1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Test Fortran binding of sort routines 3c4762a1bSJed Brown! 44d3610e3SJacob Faibussowitschmodule UserContext 5c4762a1bSJed Brown use petsc 64d3610e3SJacob Faibussowitsch#include "petsc/finclude/petsc.h" 74d3610e3SJacob Faibussowitsch implicit none 84d3610e3SJacob Faibussowitsch type uctx 94d3610e3SJacob Faibussowitsch PetscInt myint 104d3610e3SJacob Faibussowitsch end type uctx 114d3610e3SJacob Faibussowitschcontains 124d3610e3SJacob Faibussowitsch subroutine CompareIntegers(a,b,ctx,res) 134d3610e3SJacob Faibussowitsch implicit none 144d3610e3SJacob Faibussowitsch 154d3610e3SJacob Faibussowitsch PetscInt :: a,b 164d3610e3SJacob Faibussowitsch type(uctx) :: ctx 174d3610e3SJacob Faibussowitsch integer :: res 184d3610e3SJacob Faibussowitsch 194d3610e3SJacob Faibussowitsch if (a < b) then 204d3610e3SJacob Faibussowitsch res = -1 214d3610e3SJacob Faibussowitsch else if (a == b) then 224d3610e3SJacob Faibussowitsch res = 0 234d3610e3SJacob Faibussowitsch else 244d3610e3SJacob Faibussowitsch res = 1 254d3610e3SJacob Faibussowitsch end if 264d3610e3SJacob Faibussowitsch return 274d3610e3SJacob Faibussowitsch end subroutine CompareIntegers 284d3610e3SJacob Faibussowitschend module UserContext 294d3610e3SJacob Faibussowitsch 304d3610e3SJacob Faibussowitschprogram main 314d3610e3SJacob Faibussowitsch 324d3610e3SJacob Faibussowitsch use UserContext 33c4762a1bSJed Brown implicit none 34c4762a1bSJed Brown 35c4762a1bSJed Brown PetscErrorCode ierr 36c4762a1bSJed Brown PetscInt,parameter:: N=3 37c4762a1bSJed Brown PetscMPIInt,parameter:: mN=3 384d3610e3SJacob Faibussowitsch PetscInt x(N),x1(N),y(N),z(N) 39*d2c61337SStefano Zampini PetscMPIInt mx(N),my(N) 40c4762a1bSJed Brown PetscScalar s(N) 41c4762a1bSJed Brown PetscReal r(N) 42c4762a1bSJed Brown PetscMPIInt,parameter:: two=2, five=5, seven=7 434d3610e3SJacob Faibussowitsch type(uctx):: ctx 442a27bf02SStefano Zampini PetscInt i 454d3610e3SJacob Faibussowitsch PetscSizeT sizeofentry 46c4762a1bSJed Brown 47c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 48c4762a1bSJed Brown 49c4762a1bSJed Brown x = [3, 2, 1] 504d3610e3SJacob Faibussowitsch x1 = [3, 2, 1] 51c4762a1bSJed Brown y = [6, 5, 4] 52c4762a1bSJed Brown z = [3, 5, 2] 53c4762a1bSJed Brown mx = [five, seven, two] 54c4762a1bSJed Brown my = [five, seven, two] 55c4762a1bSJed Brown s = [1.0, 2.0, 3.0] 56c4762a1bSJed Brown r = [1.0, 2.0, 3.0] 57*d2c61337SStefano Zampini#if defined(PETSC_USE_64BIT_INDICES) 58*d2c61337SStefano Zampini sizeofentry = 8; 59*d2c61337SStefano Zampini#else 60*d2c61337SStefano Zampini sizeofentry = 4; 61*d2c61337SStefano Zampini#endif 624d3610e3SJacob Faibussowitsch ctx%myint = 1 63c4762a1bSJed Brown call PetscSortInt(N,x,ierr) 644d3610e3SJacob Faibussowitsch call PetscTimSort(N,x1,sizeofentry,CompareIntegers,ctx,ierr) 654d3610e3SJacob Faibussowitsch do i = 1,N 664d3610e3SJacob Faibussowitsch if (x1(i) .ne. x(i)) then 674d3610e3SJacob Faibussowitsch SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"PetscTimSort and PetscSortInt arrays did not match") 684d3610e3SJacob Faibussowitsch end if 694d3610e3SJacob Faibussowitsch end do 70c4762a1bSJed Brown call PetscSortIntWithArray(N,y,x,ierr) 71c4762a1bSJed Brown call PetscSortIntWithArrayPair(N,x,y,z,ierr) 72c4762a1bSJed Brown 73c4762a1bSJed Brown call PetscSortMPIInt(N,mx,ierr) 74c4762a1bSJed Brown call PetscSortMPIIntWithArray(mN,mx,my,ierr) 75c4762a1bSJed Brown call PetscSortMPIIntWithIntArray(mN,mx,y,ierr) 76c4762a1bSJed Brown 77c4762a1bSJed Brown call PetscSortIntWithScalarArray(N,x,s,ierr) 78c4762a1bSJed Brown 79c4762a1bSJed Brown call PetscSortReal(N,r,ierr) 80c4762a1bSJed Brown call PetscSortRealWithArrayInt(N,r,x,ierr) 81c4762a1bSJed Brown 82c4762a1bSJed Brown call PetscFinalize(ierr) 834d3610e3SJacob Faibussowitschend program main 84c4762a1bSJed Brown 85c4762a1bSJed Brown!/*TEST 86c4762a1bSJed Brown! 87c4762a1bSJed Brown! test: 88c4762a1bSJed Brown! 89c4762a1bSJed Brown!TEST*/ 90