1c4762a1bSJed Brown! 2c4762a1bSJed Brown! Test Fortran binding of sort routines 3c4762a1bSJed Brown! 4*77d968b7SBarry Smithmodule ex49fmodule 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 28*77d968b7SBarry Smithend module ex49fmodule 294d3610e3SJacob Faibussowitsch 304d3610e3SJacob Faibussowitschprogram main 314d3610e3SJacob Faibussowitsch 32*77d968b7SBarry Smith use ex49fmodule 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) 39d2c61337SStefano 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 47d8606c27SBarry Smith PetscCallA(PetscInitialize(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] 57d2c61337SStefano Zampini#if defined(PETSC_USE_64BIT_INDICES) 58d2c61337SStefano Zampini sizeofentry = 8; 59d2c61337SStefano Zampini#else 60d2c61337SStefano Zampini sizeofentry = 4; 61d2c61337SStefano Zampini#endif 624d3610e3SJacob Faibussowitsch ctx%myint = 1 63f8402805SBarry Smith PetscCallA(PetscSortInt(N,x,ierr)) 64f8402805SBarry Smith PetscCallA(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 70f8402805SBarry Smith PetscCallA(PetscSortIntWithArray(N,y,x,ierr)) 71f8402805SBarry Smith PetscCallA(PetscSortIntWithArrayPair(N,x,y,z,ierr)) 72c4762a1bSJed Brown 73f8402805SBarry Smith PetscCallA(PetscSortMPIInt(N,mx,ierr)) 74f8402805SBarry Smith PetscCallA(PetscSortMPIIntWithArray(mN,mx,my,ierr)) 75f8402805SBarry Smith PetscCallA(PetscSortMPIIntWithIntArray(mN,mx,y,ierr)) 76c4762a1bSJed Brown 77f8402805SBarry Smith PetscCallA(PetscSortIntWithScalarArray(N,x,s,ierr)) 78c4762a1bSJed Brown 79f8402805SBarry Smith PetscCallA(PetscSortReal(N,r,ierr)) 80f8402805SBarry Smith PetscCallA(PetscSortRealWithArrayInt(N,r,x,ierr)) 81c4762a1bSJed Brown 82f8402805SBarry Smith PetscCallA(PetscFinalize(ierr)) 834d3610e3SJacob Faibussowitschend program main 84c4762a1bSJed Brown 85c4762a1bSJed Brown!/*TEST 86c4762a1bSJed Brown! 87c4762a1bSJed Brown! test: 88c4762a1bSJed Brown! 89c4762a1bSJed Brown!TEST*/ 90